20170728xlVba简单的匹配

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