如何将VBA自定义Vlookup2函数转为Sub宏实现跨列匹配去重输出

直接使用下面的独立宏代码即可实现需求，无需依赖原有自定义函数，逻辑更稳定，运行效率更高：

Sub 批量查询匹配结果()
    Dim lastRowA As Long, lastRowC As Long
    Dim i As Long, lookupVal As String
    Dim dict As Object, cell As Range
    Dim resultStr As String
    
    ' 关闭屏幕更新提升运行速度
    Application.ScreenUpdating = False
    ' 初始化字典用于去重
    Set dict = CreateObject("Scripting.Dictionary")
    
    ' 获取A列和C列最后有数据的行号
    lastRowA = Cells(Rows.Count, "A").End(xlUp).Row
    lastRowC = Cells(Rows.Count, "C").End(xlUp).Row
    
    ' 逐行遍历C列查询值
    For i = 1 To lastRowC
        lookupVal = Trim(Cells(i, "C").Value)
        ' 跳过C列空行
        If lookupVal <> "" Then
            dict.RemoveAll ' 清空字典准备当前查询的结果去重
            resultStr = ""
            ' 在A列遍历查找匹配项
            For Each cell In Range("A1:A" & lastRowA)
                If Trim(cell.Value) = lookupVal Then
                    Dim bVal As String
                    bVal = Trim(cell.Offset(0, 1).Value) ' 取对应B列的值
                    ' 排除空值且字典中不存在该值则加入
                    If bVal <> "" And Not dict.exists(bVal) Then
                        dict.Add bVal, True
                    End If
                End If
            Next cell
            ' 拼接结果，用分号分隔
            If dict.Count > 0 Then
                resultStr = Join(dict.keys, ";")
            End If
            ' 输出到D列对应行
            Cells(i, "D").Value = resultStr
        Else
            ' C列为空时D列也为空
            Cells(i, "D").Value = ""
        End If
    Next i
    
    ' 恢复屏幕更新
    Application.ScreenUpdating = True
    MsgBox "查询处理完成！", vbInformation
End Sub

使用方法 #

• 按Alt+F11打开VBA编辑器，右键点击当前工作簿名称，选择「插入」-「模块」，将上述代码粘贴到模块中
• 返回Excel界面，切换到「开发工具」选项卡，点击「插入」-选择表单控件中的「按钮」，在工作表绘制按钮后，在弹出的指定宏窗口中选择批量查询匹配结果，点击确定即可
• 点击按钮即可自动完成所有行的查询匹配，输出结果到D列

效果说明 #

实现逻辑完全匹配需求：

• 逐行取C列值作为查询条件
• 在A列全匹配搜索，返回对应B列值
• 自动排除空值、重复值
• 最终结果用英文分号分隔输出到对应行D列，和预期效果一致：
  

内容的提问来源于stack exchange，提问作者Dan Kidney