Excel VBA基于两列匹配查找数据及现有代码优化咨询

需求说明 #

当前工作簿包含两个工作表，Result为结果输出表，From为数据源查询表。需要根据「班级号」和「学号」两个字段匹配查询对应学生的姓名，单个班级号、单个学号都可能存在重复，但二者的组合值唯一，每位学生对应唯一的班级号+学号组合。

原有实现 #

原有思路是新增辅助列拼接班级号和学号生成唯一检索键，再调用Vlookup函数完成匹配，代码如下：

Sub vlookupName()
    
    'get the last row of both sheets
    resultRow = Sheets("Result").[a1].CurrentRegion.Rows.Count
    fromRow = Sheets("From").[a1].CurrentRegion.Rows.Count
    
    'concat Class number and student number to get a unique string used for vlookup
    Sheets("Result").Range("D2:D" & resultRow) = "=B2 & C2"
    Sheets("From").Columns("A").Insert
    Sheets("From").Range("A2:A" & resultRow) = "=c2 & d2"
    
    'vlookup
    Sheets("Result").Range("A2:A" & resultRow) = Application.VLookup(Sheets("Result").Range("D2:D" & resultRow).Value, _
        Sheets("From").Range("a2:b" & fromRow).Value, 2, False)
        
    '(delete columns to get back to raw file for next test)
    Sheets("Result").Columns("D").Delete
    Sheets("From").Columns("A").Delete
    Sheets("Result").Range("A2:A" & resultRow) = ""
End Sub

优化建议 #

• 避免修改原表结构：原有代码需要插入、删除列，很容易误改原表数据，尤其是数据源表如果A列有内容会被直接覆盖丢失。建议改用字典做映射，全程在内存中处理，完全不需要改动原表结构。
• 修复已知bug：原有代码给From表写辅助列时误用了resultRow作为行数上限，如果From表行数多于Result表，会漏掉后半部分的数据源；最后一行清空Result表A列的代码是测试残留，会导致匹配完的结果直接被清空，正式使用需要删除。
• 规避拼接键歧义：直接拼接两个字段可能出现不同组合结果相同的问题，比如班级号12、学号3，和班级号1、学号23，直接拼接后都是123，会导致匹配错误。建议在两个字段中间加一个不会出现在学号、班级号里的分隔符（比如|、_）。
• 提升运行效率：原有代码反复读写单元格、写入公式，数据量大会非常卡顿。建议把表数据全部读入数组，内存中处理完成后一次性写回，搭配关闭屏幕更新、自动计算，速度可以提升数十倍。
• 增加健壮性：可以新增表存在性判断、空值校验、匹配不到的异常处理，避免代码运行报错。

优化后代码示例 #

Sub MatchStudentName()
    Dim dict As Object, fromArr, resultArr
    Dim i As Long, key As String, fromRow As Long, resultRow As Long
    
    ' 关闭屏幕更新、自动计算提速
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    Set dict = CreateObject("Scripting.Dictionary")
    
    ' 读取数据源表内容到数组：From表B列姓名、C列班级、D列学号
    With Sheets("From")
        fromRow = .Cells(.Rows.Count, "C").End(xlUp).Row
        fromArr = .Range("B2:D" & fromRow).Value
    End With
    
    ' 生成班级+学号到姓名的映射字典
    For i = 1 To UBound(fromArr)
        key = fromArr(i, 2) & "|" & fromArr(i, 3) ' 加分隔符避免拼接歧义
        If Not dict.exists(key) Then dict(key) = fromArr(i, 1)
    Next i
    
    ' 读取结果表内容到数组：Result表A列待填姓名、B列班级、C列学号
    With Sheets("Result")
        resultRow = .Cells(.Rows.Count, "B").End(xlUp).Row
        resultArr = .Range("A2:C" & resultRow).Value
    End With
    
    ' 批量匹配姓名
    For i = 1 To UBound(resultArr)
        key = resultArr(i, 2) & "|" & resultArr(i, 3)
        resultArr(i, 1) = IIf(dict.exists(key), dict(key), "未找到")
    Next i
    
    ' 一次性写回匹配结果
    Sheets("Result").Range("A2").Resize(UBound(resultArr), 1).Value = resultArr
    
    ' 恢复Excel默认设置
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Set dict = Nothing
End Sub

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