如何使用VBA按Items匹配将Table1的Num值复制到Table2？

当然可以用VBA实现这个需求，以下是两种适合长列表的高效实现方式：

方法一：使用VLOOKUP函数（简洁快速） #

如果数据量不是极端庞大，直接通过VBA调用工作表函数VLOOKUP是最快捷的选择：

Private Sub Import_Click()
    Dim wsTest As Worksheet, wsTest2 As Worksheet
    Dim table2ItemsRange As Range, table2NumRange As Range
    Dim table1Range As Range
    
    ' 定义工作表对象
    Set wsTest = ThisWorkbook.Worksheets("test")
    Set wsTest2 = ThisWorkbook.Worksheets("test2")
    
    ' 定义Table2的Items列和目标Num列范围（请根据实际位置调整）
    Set table2ItemsRange = wsTest.Range("A10:A49") ' 假设Table2的Items在A10:A49
    Set table2NumRange = wsTest.Range("D10:D49") ' 需要填充Num的目标列
    
    ' 定义Table1的数据源范围（Items列+Num列，假设Table1在test2的G22:H61，G为Items、H为Num）
    Set table1Range = wsTest2.Range("G22:H61")
    
    ' 批量写入VLOOKUP公式，再转成静态值
    table2NumRange.Formula = "=VLOOKUP(" & table2ItemsRange.Cells(1).Address(False, False) & "," & table1Range.Address(External:=True) & ",2,FALSE)"
    table2NumRange.Value = table2NumRange.Value ' 把公式结果转为固定值
End Sub

方法二：使用字典（高效处理超大量数据） #

如果列表行数极多（比如上万行），用字典做匹配会比函数更快，避免公式计算的性能开销：

Private Sub Import_Click()
    Dim wsTest As Worksheet, wsTest2 As Worksheet
    Dim table1Data As Variant, table2Items As Variant
    Dim numDict As Object
    Dim i As Long
    
    ' 初始化字典
    Set numDict = CreateObject("Scripting.Dictionary")
    numDict.CompareMode = vbTextCompare ' 不区分大小写匹配，不需要可删除
    
    ' 定义工作表
    Set wsTest = ThisWorkbook.Worksheets("test")
    Set wsTest2 = ThisWorkbook.Worksheets("test2")
    
    ' 把Table1数据读入数组（提升处理速度）
    table1Data = wsTest2.Range("G22:H61").Value
    
    ' 遍历Table1，将Items作为键、Num作为值存入字典
    For i = LBound(table1Data, 1) To UBound(table1Data, 1)
        If Not numDict.Exists(table1Data(i, 1)) Then
            numDict(table1Data(i, 1)) = table1Data(i, 2)
        End If
    Next i
    
    ' 读取Table2的Items列到数组
    table2Items = wsTest.Range("A10:A49").Value
    
    ' 遍历Table2，匹配字典值并写入
    For i = LBound(table2Items, 1) To UBound(table2Items, 1)
        If numDict.Exists(table2Items(i, 1)) Then
            wsTest.Range("D" & i + 9).Value = numDict(table2Items(i, 1)) ' 对应第10行开始的位置
        Else
            wsTest.Range("D" & i + 9).Value = "无匹配" ' 无匹配时的默认值，可修改为""留空
        End If
    Next i
    
    ' 释放对象
    Set numDict = Nothing
End Sub

注意事项 #

• 请根据你的实际表格布局，修改代码中的单元格范围参数
• 方法二中的vbTextCompare用于关闭大小写敏感匹配，若需要严格区分大小写，可删除该行
• 无匹配项的默认值可按需调整，比如直接留空就写wsTest.Range("D" & i + 9).Value = ""

内容的提问来源于stack exchange，提问作者Abhishek V. Pai