Public dicObject As Object
Public isChanged As Boolean
Sub Main()
Dim arrSrc, key
Dim lRow As Long
If (dicObject Is Nothing) Or (isChanged = True) Then
CreateDic Sheet1.Range("M3:M1000"), Sheet1.Range("L3:L1000"), dicObject
End If
With Sheet1.Range("C3:C100")
arrSrc = .Value
ReDim arrDes(1 To UBound(arrSrc), 1 To 1)
For lRow = 1 To UBound(arrSrc, 1)
key = arrSrc(lRow, 1)
If dicObject.Exists(key) Then arrDes(lRow, 1) = dicObject.item(key)
Next
.Offset(, -1).Value = arrDes
End With
isChanged = False
End Sub
Private Sub CreateDic(ByVal rngKeys As Range, ByVal rngItems As Range, ByRef dict As Object)
Dim lRow As Long, lCol As Long
Dim arrKeys(), arrItems(), key, item
Set dict = CreateObject("Scripting.Dictionary")
If rngKeys.Count = 1 Then
ReDim arrKeys(1 To 1, 1 To 1)
ReDim arrItems(1 To 1, 1 To 1)
arrKeys(1, 1) = rngKeys.Value
arrItems(1, 1) = rngItems(1, 1).Value
Else
Set rngItems = rngItems.Resize(rngKeys.Rows.Count, rngKeys.Columns.Count)
arrKeys = rngKeys.Value
arrItems = rngItems.Value
End If
For lRow = 1 To UBound(arrKeys, 1)
For lCol = 1 To UBound(arrKeys, 2)
key = arrKeys(lRow, lCol)
item = arrItems(lRow, lCol)
If key <> Empty Then
If Not dict.Exists(key) Then dict.Add key, item
End If
Next
Next
End Sub
