Sub ex()
Set d = CreateObject("Scripting.Dictionary") '«Ø¥ß¤@Ó¦r¨åÅܼÆ
For Each a In Range([F5], [F65536].End(xlUp))
d(a & "") = a.Offset(, 1).Value '§âFÄæ¸ê®Æ·í§@¯Á¤Þ¡AGÄæ¸ê®Æ°µ¹ïÀ³ª½
Next
For Each a In Range([B4], [B65536].End(xlUp)) '¥HBÄæ¸ê®Æ°µ°j°é
For Each ky In d.keys '¦r¨åª«¥óªº¨CÓ¯Á¤ÞÈ°µ°j°é
If InStr(a, ky) > 0 Then a.Offset(, 2) = d(ky): Exit For '¦pªG¯Á¤ÞȦ³³QBÄæ¸ê®Æ¥]§t®É¡A±NDÄæ¶ñ¤J¯Á¤Þªº¹ïÀ³È
Next
Next
End Sub