Hsieh

¦^´_ 3# greetingsfromtw

1. Sub ex()
   
2. Set d = CreateObject("Scripting.Dictionary")
   
3. Set Rng = Range("J1").CurrentRegion.SpecialCells(xlCellTypeConstants) '¤ñ¹ï°}¦C
   
4. For Each a In Range([A2], [A2].End(xlDown)) '­ì©l¸ê®Æ°j°é
   
5.   For Each c In Rng
   
6.      If InStr(UCase(a), UCase(c)) > 0 Then
   
7.         d(c.Column) = "" '°O¦í¤ñ¹ï¨ì°}¦CªºÄæ¦ì
   
8.      End If
   
9.   Next
   
10.   If d.Count > 0 Then 'ªí¥Ü­ì©l¸ê®Æ¤ñ¹ï¦¨¥\
    
11.      For Each ky In d.keys
    
12.        Cells(65536, ky - 8).End(xlUp).Offset(1, 0) = a
    
13.      Next
    
14.      d.RemoveAll '²MªÅ¦r¨å
    
15.      Else
    
16.      Cells(65536, "E").End(xlUp).Offset(1, 0) = a '¤ñ¹ï¤£¦¨¥\
    
17.   End If
    
18. Next
    
19. End Sub

½Æ»s¥N½X