替换为匹配项

• 为了简单起见，假设范围具有至少两行数据。

Sub ReplaceWithMatches()
    
    ' 1.) Read
    
    ' Workbook
    Dim wb As Workbook: Set wb = ThisWorkbook
    
    ' Source
    Dim sws As Worksheet: Set sws = wb.Worksheets("Sheet2")
    Dim srg As Range
    Set srg = sws.Range("A2", sws.Cells(sws.Rows.Count, "B").End(xlUp))
    Dim slrg As Range: Set slrg = srg.Columns(2) ' lookup
    Dim svData() As Variant: svData = srg.Columns(1).Value ' value
    
    ' Destination
    Dim dws As Worksheet: Set dws = wb.Worksheets("Sheet1")
    Dim drg As Range
    Set drg = dws.Range("A2", dws.Cells(dws.Rows.Count, "A").End(xlUp))
    Dim dData() As Variant: dData = drg.Value ' lookup & value
    
    ' 2.) Modify
    
    ' Loop
    Dim srIndex As Variant ' could be an error value
    Dim dr As Long
    For dr = 1 To UBound(dData, 1)
        srIndex = Application.Match(dData(dr, 1), slrg, 0)
        If IsNumeric(srIndex) Then ' match found
            dData(dr, 1) = svData(srIndex, 1)
        'Else ' no match found; do nothing?
        End If
    Next dr
    
    ' 3.) Write
    
    ' Result
    drg.Value = dData

End Sub