Dim data, temp, arr
Dim d
Dim i&, k&
Set d = CreateObject("scripting.dictionary") '建立字典
data = [a1].CurrentRegion '將A1所在區域寫入數組
For i = 2 To UBound(data) '在數組中循環
d(data(i, 1) & "") = data(i, 2) '將數組中的data(i,1)&""寫入字典，並賦於data(i,2)的值
Next
temp = [d1].CurrentRegion '將d1所在區域寫入數組temp
ReDim arr(2 To UBound(temp), 1 To 1) '重新定義數組arr的大小
For k = 2 To UBound(temp) '在數組中在循環
arr(k, 1) = d(temp(k, 1)) '將字典中d(temp(k, 1))所對應的值賦給arr(k,1)，與data(i,2)即第二列相對應
Next
[e2].Resize(UBound(arr) - 1, 1) = arr '將數組arr輸出到單元格
Set d = Nothing
End Sub