|
Sub test()
Set d = CreateObject("scripting.dictionary")
With Sheet1
r = .Cells(Rows.Count, 1).End(xlUp).Row
ar = .Range("a1:b" & r)
rs = .Cells(Rows.Count, 6).End(xlUp).Row
.Range("g2:g" & rs + 1).ClearContents
br = .Range("f2:g" & rs)
For i = 2 To UBound(ar)
If Trim(ar(i, 1)) <> "" Then
d(Trim(ar(i, 1))) = ar(i, 2)
End If
Next i
For i = 1 To UBound(br)
If Trim(br(i, 1)) <> "" Then
For s = 2 To UBound(ar)
If InStr(br(i, 1), ar(s, 1)) > 0 Then
br(i, 2) = ar(s, 2)
Exit For
End If
Next s
End If
Next i
.Range("f2:g" & rs) = br
End With
End Sub
|
|