Excel VBA 自定义MyXLOOKUP函数

☆本期内容概要☆

• 自定义函数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 = ResultEnd 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内置函数，以免给工作带来不必要的麻烦。