【VBAPlanet】如何实现数据精确查询与匹配

大家好，我是海林，今天跟大家分享的VBA小代码主题是数据精确查询与匹配。

我们用王者荣耀的数据来举例，如下图所示。根据A:C列的数据源信息，查询E列英雄名相应的职业类型，如果查询无结果，则返回空白。

此类问题常用的解决办法有三种，一种是Find方法，另一种是If条件判断，以及Vlookup方法。

1.Find方法

Sub RngFind()
    Dim Rng1 As Range, Rng2 As Range
    Dim arr As Variant, i As Long
    Set Rng1 = Range("b1:c" & Cells(Rows.Count, 2).End(xlUp).Row)
    '数据源赋值Rng
    arr = Range("e1:f" & Cells(Rows.Count, 5).End(xlUp).Row)
    '查询区域装入数组arr
    For i = 2 To UBound(arr) '遍历查询区域
        arr(i, 2) = ""
         '清空原结果
        Set Rng2 = Rng1.Find(arr(i, 1), lookat:=xlWhole)
        'xlwhole精确查找模式，xlpart模糊查找模式
        If Not Rng2 Is Nothing Then
        '如果有查找到相应单元格则Rng2必然非nothing，那么
            arr(i, 2) = Rng2.Offset(0, 1)
            '对查找到的单元格通过offset偏移取值
        Else
            arr(i, 2) = "" '否则返回空值
        End If
    Next
    With Range("e1:f" & Cells(Rows.Count, 5).End(xlUp).Row)
        .NumberFormat = "@"
        '设置单元格文本格式，避免文本数值变形
        .Value = arr
        '将arr放回单元格区域
    End With
    MsgBox "OK"
End Sub

2.If条件判断

Sub IfDemo()
    Dim arr1 As Variant, arr2 As Variant, i As Long, j As Long
    arr1 = Range("a1:c" & Cells(Rows.Count, 2).End(xlUp).Row)
    '数据源装入数组arr1
    arr2 = Range("e1:f" & Cells(Rows.Count, 5).End(xlUp).Row)
    '查询区域装入数组arr2
    For i = 2 To UBound(arr2)
    '遍历查询区域
        arr2(i, 2) = ""
        '清空原结果
        For j = 2 To UBound(arr1)
            If arr1(j, 2) = arr2(i, 1) Then
                '模糊查询可使用Instr函数和like语句，Instrd的vbTextCompare参数不区分字母大小写，like语句区分字母大小写
                arr2(i, 2) = arr1(j, 3)
                Exit For '找到结果后，退出遍历arr1
            End If
        Next
    Next
    With Range("e1:f" & Cells(Rows.Count, 5).End(xlUp).Row)
        .NumberFormat = "@"
        '设置单元格文本格式，避免文本数值变形
        .Value = arr2
        '将arr2放回单元格区域
    End With
    MsgBox "OK"
End Sub

3.Vlookup方法

Sub RngVlookup()
    Dim arr As Variant, i As Long
    arr = Range("e1:f" & Cells(Rows.Count, 5).End(xlUp).Row)
    '查询区域装入数组arr
    For i = 2 To UBound(arr) '遍历查询区域
        arr(i, 2) = ""
         '清空原结果
        arr(i, 2) = Application.VLookup(arr(i, 1), Range("B:C"), 2, 0)
         '若是模糊匹配，VLookup最后一个参数是1
    Next
    With Range("e1:f" & Cells(Rows.Count, 5).End(xlUp).Row)
        .NumberFormat = "@"
        '设置单元格文本格式，避免文本数值变形
        .Value = arr
        '将arr放回单元格区域
    End With
    Range("F" & Cells(Rows.Count, 5).End(xlUp).Row).Select
    Selection.Replace What:="#N/A", Replacement:="", LookAt:=xlPart
    '对于没有匹配上的错误值替换成空值
    MsgBox "OK"
End Sub

禅定时刻

1.按笔者经验，数据量大时，Vlookup方法速度较快；
2.多条件查询匹配时，条件语句可以这样写：

If arr1(j, 1) & arr1(j, 2) =  arr2(i, 1) & arr2(i, 2) Then

希望以上内容对你有帮助。