Excel for Mac VBA实现匹配两列相同值填充对应单元格数据

优化后兼容Excel for Mac的VBA宏代码 #

以下代码采用字典预存球员-积分映射关系，仅需2次遍历即可完成所有匹配，相比原硬编码写法效率提升明显，且支持任意数量的球员数据，完全兼容Mac版Excel：

Sub fantasyPlayer()
    Dim wb As Workbook, ws As Worksheet
    Dim lastRowA As Long, lastRowC As Long, i As Long
    Dim playerDict As Object
    
    ' 晚绑定创建字典，无需提前引用库，适配Mac版Excel
    Set playerDict = CreateObject("Scripting.Dictionary")
    Set wb = ActiveWorkbook
    Set ws = ActiveSheet
    
    With ws
        ' 获取C列、A列最后有数据的行号
        lastRowC = .Cells(.Rows.Count, "C").End(xlUp).Row
        lastRowA = .Cells(.Rows.Count, "A").End(xlUp).Row
        
        ' 遍历C、D列，预存球员姓名和对应积分到字典
        For i = 2 To lastRowC
            If Not playerDict.Exists(.Range("C" & i).Value) Then
                ' 若C列有重名球员，默认保留第一个出现的积分，如需保留最后一个可去掉上面的If判断
                playerDict(.Range("C" & i).Value) = .Range("D" & i).Value
            End If
        Next i
        
        ' 遍历A列，匹配字典内容直接填充B列
        For i = 2 To lastRowA
            If playerDict.Exists(.Range("A" & i).Value) Then
                .Range("B" & i).Value = playerDict(.Range("A" & i).Value)
            End If
        Next i
    End With
    
    ' 释放对象
    Set playerDict = Nothing
    Set ws = Nothing
    Set wb = Nothing
End Sub

补充说明 #

• 代码默认C列无重复球员，若存在重名会保留第一个出现的球员积分，如需保留最后一次出现的积分，删除预存字典环节的If Not playerDict.Exists判断即可
• 所有操作均在内存中完成匹配，不会产生多余的单元格读写操作，数据量较大时也能保持很高的运行速度

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