Excel VBA 自定义MyXLOOKUP函数-今日头条

本文于2023年6月11日首发于本人同名公众号：Excel活学活用，更多文章案例请搜索关注！

☆本期内容概要☆

自定义函数MyXLOOKUP()

大家好，我是冷水泡茶，随着OFFICE不断升级，新的函数也时有出现，比如XLOOKUP，曾经一度火爆全网（我说的是不是有点夸张了？也许，但各大博主争相推荐倒是不假。）说什么彻底取代VLOOKUP云云。

今天我们就来看一下这个查询利器，我上网搜了一搜，找到微软官网上的一篇文章：XLOOKUP 函数 - Microsoft 支持，介绍得非常详细，我就不画蛇添足了，感兴趣的朋友可以移步第二条推文。

XLOOKUP好是好，然，低版本的OFFICE并不能用，光看着眼馋没办法。

难道真的就这样算了吗？继续用我们的VLOOKUP？

来来来，我们有VBA啊，我们自己搞一个试试，看能不能实现XLOOKUP的功能。

其实这个问题我老早就想过了，只是一直没有功夫来做。今天得空，我们来偿试一把。

XLOOKUP的参数比较多，但基本的有3个，是必填项：

1、lookup_value：要搜索的值

2、lookup_array：要搜索的数组或区域

3、return_array：要返回的数组或区域

到这问题基本就明朗了，就是循环数组，找到相同的值，然后把另一个数组对应位置的值作为函数的结果。

但动手写代码总是有点头疼的，还是把问题交给ChatGPT吧，让它写一个类似XLOOKUP的自定义函数：

Function MyXLOOKUP1(lookup_value As Variant, _
    lookup_range As Range, _
    return_range As Range) As Variant
    Dim lookup_array As Variant
    Dim return_array As Variant
    Dim i As Long
    lookup_array = lookup_range.Value
    return_array = return_range.Value
    For i = 1 To UBound(lookup_array, 1)
        If lookup_array(i, 1) = lookup_value Then
            MyXLOOKUP1 = return_array(i, 1)
            Exit Function
        End If
    Next i
    MyXLOOKUP1 = CVErr(xlErrNA) ' 如果没有找到匹配项，则返回#N/A错误
End Function

这里有个CVErr函数，还是第一次遇到，再问AI吧，AI就是好，它总是不厌其烦回答你的问题：

CVErr是一个VBA函数，用于创建表示特定错误类型的Variant类型的值。它用于在VBA代码中处理错误。

CVErr 函数接受一个整数参数，该参数对应于不同的错误类型。以下是一些常见的 CVErr 错误类型：

xlErrDiv0 (错误码: 2007)：表示除零错误。

xlErrNA (错误码: 2042)：表示找不到值或无效结果。

xlErrName (错误码: 2029)：表示无效的函数或命名范围。

xlErrNull (错误码: 2000)：表示无效的空值。

xlErrNum (错误码: 2036)：表示无效的数值。

xlErrRef (错误码: 2023)：表示无效的引用。

使用CVErr 函数可以将这些错误类型的值分配给变量，以在程序中进行错误处理或返回给调用者。如，CVErr(xlErrNA) 会创建一个代表找不到值或无效结果的Variant 类型的值。

请注意，CVErr函数的返回值是一种特殊的数据类型 Error，如果将其赋给变量，需要使用 Variant 类型来接收该值。

这些东西谁能记得？先记录下来备用吧。

函数代码不复杂，测试可用。但XLOOKUP后面还有一串参数呢，咋整？这次再问AI，结果就没那么理想了，具体过程不说了，我自己改吧，最后基本完成，我测试了一下，基本达到预期：

函数完整代码如下：

Function MyXLOOKUP(Lookup_Value, _
        Lookup_Array, Return_Array, _
        Optional if_Not_Found, _
        Optional match_Mode As Integer = 0, _
        Optional Search_Mode As Integer = 1)
    Dim Lookup_Values
    Dim Return_Values
    Dim Result
    t = 0
    temp = ""
    If TypeOf Lookup_Value Is Range Then
        Lookup_Values = Lookup_Array.Value
    Else
        Lookup_Values = Lookup_Array
    End If
    If TypeOf Return_Values Is Range Then
        Return_Values = Return_Array.Value
    Else
        Return_Values = Return_Array
    End If
    If match_Mode = 0 Then
        '精确匹配
        If Search_Mode = 1 Then
            For i = LBound(Lookup_Values, 1) To UBound(Lookup_Values, 1)
                If Lookup_Values(i, 1) = Lookup_Value Then
                    Result = Return_Values(i, 1)
                    Exit For
                End If
            Next
        Else
            For i = UBound(Lookup_Values, 1) To LBound(Lookup_Values, 1) Step -1
                If Lookup_Values(i, 1) = Lookup_Value Then
                    Result = Return_Values(i, 1)
                    Exit For
                End If
            Next
        End If
    ElseIf match_Mode = -1 Then
        '精确匹配，若无匹配，则返回第一个最接近且比查找值小的值。
        If Search_Mode = 1 Then
            For i = LBound(Lookup_Values, 1) To UBound(Lookup_Values, 1)
                If Lookup_Values(i, 1) = Lookup_Value Then
                    Result = Return_Values(i, 1)
                    t = 1
                    Exit For
                End If
            Next
        Else
            For i = UBound(Lookup_Values, 1) To LBound(Lookup_Values, 1) Step -1
                If Lookup_Values(i, 1) = Lookup_Value Then
                    Result = Return_Values(i, 1)
                    t = 1
                    Exit For
                End If
            Next
        End If
        If t = 0 Then
            If Search_Mode = 1 Then
                For i = LBound(Lookup_Values, 1) To UBound(Lookup_Values, 1)
                    If Lookup_Values(i, 1) < Lookup_Value Then
                        If Lookup_Values(i, 1) > temp Then
                            temp = Lookup_Values(i, 1)
                            Result = Return_Values(i, 1)
                        End If
                    End If
                Next
            Else
                For i = UBound(Lookup_Values, 1) To LBound(Lookup_Values, 1) Step -1
                    If Lookup_Values(i, 1) < Lookup_Value Then
                        '
                        If Lookup_Values(i, 1) > temp Then
                            temp = Lookup_Values(i, 1)
                            Result = Return_Values(i, 1)
                        End If
                    End If
                Next
            End If
        End If
    Else
        '精确匹配，若无匹配，则返回第一个最接近查找值的较其大值。
        If Search_Mode = 1 Then
            For i = LBound(Lookup_Values, 1) To UBound(Lookup_Values, 1)
                If Lookup_Values(i, 1) = Lookup_Value Then
                    Result = Return_Values(i, 1)
                    t = 1
                    Exit For
                End If
            Next
        Else
            For i = UBound(Lookup_Values, 1) To LBound(Lookup_Values, 1) Step -1
                If Lookup_Values(i, 1) = Lookup_Value Then
                    Result = Return_Values(i, 1)
                    t = 1
                    Exit For
                End If
            Next
        End If
        If t = 0 Then
            If Search_Mode = 1 Then
                For i = LBound(Lookup_Values, 1) To UBound(Lookup_Values, 1)
                    If Lookup_Values(i, 1) > Lookup_Value Then
                        If temp = "" Then
                            temp = Lookup_Values(i, 1)
                            Result = Return_Values(i, 1)
                        End If
                        If Lookup_Values(i, 1) < temp Then
                            temp = Lookup_Values(i, 1)
                            Result = Return_Values(i, 1)
                        End If
                    End If
                Next
            Else
                For i = UBound(Lookup_Values, 1) To LBound(Lookup_Values, 1) Step -1
                    If Lookup_Values(i, 1) > Lookup_Value Then
                        If temp = "" Then
                            temp = Lookup_Values(i, 1)
                            Result = Return_Values(i, 1)
                        End If
                        If Lookup_Values(i, 1) < temp Then
                            temp = Lookup_Values(i, 1)
                            Result = Return_Values(i, 1)
                        End If
                    End If
                Next
            End If
        End If
    End If
    If IsEmpty(Result) Then
        If Not IsMissing(if_Not_Found) Then
            Result = if_Not_Found
        Else
            Result = CVErr(xlErrNA)
        End If
    End If
    MyXLOOKUP = Result
End Function

代码解析：

1、默认模式：循环目标区域数组，找匹配值，找到匹配值，则返回return_array中对应的值，找不到返回错误值。

2、match_mode=-1，表示精确匹配，若匹配不到则找一个比查找值小的且最接近查找值的值，返回return_array中对应的值，找不到返回错误值。

这里首先进行循环查找，如果查到，则使t=1，退出循环。接着进行判断，如果t=0，则表明没有精确匹配到，这时我们要找一个较小值。

3、match_mode=1 或者其他值，找较大的，其他同上。

4、search_mode，默认为1，从前往后查，其他值，从后往前查。这里两种search_mode的区别在于，当有lookup_array中有相同的值，而return_array中对应的值却不同，则会使得两种查询方式的结果不同。

5、代码经简单测试通过，可能存在BUG。目前该自定义函数仅适用纵向查找。lookup_array，return_array均为同等大小的纵向单列区域。

6、以上代码仅为研究测试VBA编码功能之用，若有朋友用于数据查询分析的，请谨慎参考。建议尽量使用EXCEL内置函数，以免给工作带来不必要的麻烦。

好，今天就到这吧。请大家多多点赞、留言、分享，谢谢大家，我们下期再会。

本文于2023年6月11日首发于本人同名公众号：Excel活学活用，更多文章案例请搜索关注！

Excel VBA 自定义MyXLOOKUP函数

头条热榜

精彩视频