🎯 【Excel黑科技】全表智能搜！VBA自定义函数实现「跨列精准查找 + 智能定位 + 多结果返回」，告别VLOOKUP局限！：

✅ VBA 函数：FindExactInRange

✅ 功能亮点：

💡 使用场景：

• 在 A:J 区域查找“订单号12345”，返回对应行的“客户姓名”（如 E 列）
• 查找“张三”，返回其“联系电话”（支持重复姓名返回多个电话）

✅ VBA 代码：

' =============================================================================
' 函数名称：FindExactInRange
' 功能：在指定范围内精确查找某个值，返回对应行指定列的内容（支持多结果）
' 作者：Qwen（阿里云）
' 版本：2.0 - 精准匹配 + 多结果 + 性能优化
' 示例：=FindExactInRange("张三", Sheet4!A:J, 5) → 返回第5列所有匹配结果
' =============================================================================

Function FindExactInRange(lookup_value As Variant, search_range As Range, return_column As Integer, Optional delimiter As String = ",") As Variant
    Dim data As Variant
    Dim result As String
    Dim i As Long, j As Long
    Dim result_col_index As Long
    Dim foundCount As Long
    
    ' 初始化返回值
    result = ""
    foundCount = 0
    
    ' 输入验证
    If search_range Is Nothing Then
        FindExactInRange = CVErr(xlErrValue)
        Exit Function
    End If
    
    If return_column < 1 Then
        FindExactInRange = "错误：返回列必须 ≥ 1"
        Exit Function
    End If
    
    ' 将范围读入数组（提升性能）
    data = search_range.Value
    
    ' 计算返回列在 search_range 中的相对列号
    result_col_index = return_column
    If result_col_index > UBound(data, 2) Then
        FindExactInRange = "错误：返回列超出范围"
        Exit Function
    End If
    
    ' 遍历数组进行精确匹配
    For i = 1 To UBound(data, 1)
        For j = 1 To UBound(data, 2)
            ' 精确匹配（区分大小写可选，此处为不区分）
            If StrComp(CStr(data(i, j)), CStr(lookup_value), vbTextCompare) = 0 Then
                ' 获取返回列的值
                Dim returnVal As String
                returnVal = CStr(data(i, result_col_index))
                
                ' 拼接结果
                If foundCount > 0 Then
                    result = result & delimiter & returnVal
                Else
                    result = returnVal
                End If
                foundCount = foundCount + 1
                
                ' 找到后跳出内层循环（避免一行多次匹配）
                Exit For
            End If
        Next j
    Next i
    
    ' 返回结果
    If foundCount = 0 Then
        FindExactInRange = "未找到"
    ElseIf foundCount = 1 Then
        FindExactInRange = result
    Else
        ' 支持动态数组溢出（Excel 365）
        Dim resultArr() As String
        resultArr = Split(result, delimiter)
        FindExactInRange = Application.Transpose(resultArr) ' 垂直返回
    End If
End Function

✅ 使用方法

1. 打开 VBA 编辑器

• Alt + F11
• 插入模块（Module）
• 粘贴以上代码

2. 在 Excel 中使用公式

✅ Excel 365 用户：多结果会自动垂直溢出显示！

📌 小贴士

• 若只想返回第一个匹配项，可在函数末尾强制返回 Split(result, delimiter)(0)
• 可修改 vbTextCompare 为 vbBinaryCompare 实现区分大小写
• 支持查找数字、文本、日期等所有类型

🎁 附加：一键调用宏（可选）

Sub SearchAndHighlight()
    Dim searchVal As String
    searchVal = InputBox("请输入要查找的内容：")
    Dim result As Variant
    result = FindExactInRange(searchVal, Selection, 1)
    MsgBox "找到结果：" & result, , "智能查找结果"
End Sub

原创不易，转载请注明出处