如何用VBA遍历Sheet1列并匹配Sheet2键值对替换数值

实现思路 #

1. 先将Sheet2的键值对存入字典，以数值（Sheet2列B）为键，对应的键（Sheet2列A）为值，确保每个数值只保留第一个匹配的键。
2. 遍历Sheet1目标列，通过字典快速查找并替换数值为对应的键。

VBA代码 #

Sub ReplaceValuesWithKeys()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim valueDict As Object
    Dim lastRow1 As Long, lastRow2 As Long
    Dim i As Long
    
    ' 绑定工作表
    Set ws1 = ThisWorkbook.Sheets("Sheet1")
    Set ws2 = ThisWorkbook.Sheets("Sheet2")
    Set valueDict = CreateObject("Scripting.Dictionary")
    
    ' 获取Sheet2数据最后一行
    lastRow2 = ws2.Cells(ws2.Rows.Count, "B").End(xlUp).Row
    
    ' 填充字典：键=Sheet2列B的数值，值=Sheet2列A的对应键
    For i = 2 To lastRow2
        Dim currentValue As Double
        currentValue = ws2.Cells(i, "B").Value
        If Not valueDict.Exists(currentValue) Then
            valueDict.Add currentValue, ws2.Cells(i, "A").Value
        End If
    Next i
    
    ' 处理Sheet1，替换数值为对应键
    lastRow1 = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row
    For i = 2 To lastRow1
        Dim cellValue As Double
        cellValue = ws1.Cells(i, "A").Value
        If valueDict.Exists(cellValue) Then
            ws1.Cells(i, "A").Value = valueDict(cellValue)
        Else
            ' 可选：标记无匹配项的单元格
            ws1.Cells(i, "A").Value = "No Match"
        End If
    Next i
    
    ' 释放对象
    Set valueDict = Nothing
    Set ws1 = Nothing
    Set ws2 = Nothing
    
    MsgBox "替换完成！", vbInformation
End Sub

使用说明 #

• 若你的工作表名称不是Sheet1/Sheet2，请修改代码中ThisWorkbook.Sheets("Sheet1")和ThisWorkbook.Sheets("Sheet2")的名称。
• 对于Sheet2中多个键对应同一数值的情况（如100对应多个键），代码会保留第一个出现的键。
• 若Sheet1中的数值在Sheet2无匹配，会被替换为"No Match"，可根据需求删除该逻辑（直接保留原数值）。
• 运行前请保存工作簿，避免数据丢失。

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