Sub MatchData()
Dim i As Long, EndRow As Long, Key As String
Dim Rng As Range
Dim Dic As Object
Set Dic = CreateObject("Scripting.Dictionary")
'获取数据来源
With Sheets("数据来源")
EndRow = .Cells(.Cells.Rows.Count, 1).End(xlUp).Row
Set Rng = .Range("A2:Z" & EndRow)
Arr = Rng.Value
For i = LBound(Arr) To UBound(Arr)
Key = CStr(Arr(i, 2))
If Len(Key) > 0 Then '除去空白行
Dic(Key) = Arr(i, 3)
End If
Next i
End With
'输出匹配结果
With Sheets("匹配结果")
EndRow = .Cells(.Cells.Rows.Count, 1).End(xlUp).Row
For i = 2 To EndRow
Key = .Cells(i, 2).Text
.Cells(i, 3).Value = Dic(Key)
'.Cells(i, 4).Value = Dic.Exists(Key)
Next i
End With
Set Dic = Nothing
Set Rng = Nothing
End Sub
