GBKEE

¦^´_ 1# Patrick_Y
¸Õ¸Õ¬Ý

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim A As Range, I, D
   
4.     Set D = CreateObject("Scripting.Dictionary")
   
5.     With ActiveSheet
   
6.         For Each A In .Range("A4:A600")
   
7.           D(A.Value) = IIf(D(A.Value) = "", A.Offset(, 1).Value, D(A.Value) & "," & A.Offset(, 1))
   
8.         Next
   
9.         With .Cells(1, Columns.Count).Resize(D.Count)                                       '¤u§@ªíªº³Ì¥kÃä¤@Äæ
   
10.             .Cells = Application.WorksheetFunction.Transpose(D.keys)                  '¾É¤J¸ê®Æ
    
11.             .Cells.Sort Key1:=.Cells(1), Order1:=xlAscending, Header:=xlNo         '±Æ§Ç,¨S¦³¼ÐÃD¦C
    
12.             company1.List = .Value
    
13.             .Clear                                                                                                      '²M°£
    
14.         End With
    
15.     End With
    
16. End Sub

½Æ»s¥N½X