lee88

¦^´_ 2# Andy2483

1. Option Explicit
   
2. 
   
3. Sub ¸ê®Æ¾ã²z¬Û¥[()
   
4.     Dim D As Object, E As Range, B As Variant
   
5.     Set D = CreateObject("Scripting.Dictionary")
   
6.     For Each E In [A1:A30]     '  ¶Ã¼Æ»s§@½d¨Òªº¦s©ñ³B
   
7.         If Not D.exists(E & UCase(E.Range("b1"))) Then   '¦r¨åª«¥óªºkey(ÃöÁä¦r)   ¤£¦s¦b®É  (¤é´Á&²£«~)
   
8.             D(E & E.Range("b1")) = Array(E.Text, UCase(E.Range("b1")), E.Range("c1").Text)
   
9.             '¦r¨åª«¥ó(ÃöÁä¦r)ªºitem(¤º®e)  ¬°¤@ºû°}¦C
   
10.         Else
    
11.             B = D(E & UCase(E.Range("b1")))  'Ū¨ú¦r¨åª«¥ó(ÃöÁä¦r)ªºitem(¤º®e)
    
12.             B(2) = B(2) + E.Range("c1")              '¼Æ¶q¬Û¥[
    
13.             D(E & UCase(E.Range("b1"))) = B   '¦r¨åª«¥ó(ÃöÁä¦r)= «ü©w¤º®e
    
14.         End If
    
15.     Next
    
16.     With [H1].Resize(D.Count, 3)   '¾ã²z¬Û¥[¦s©ñ³B
    
17.         .Value = Application.Transpose(Application.Transpose(D.ItemS)) 'Âà¸m¤@ºû°}¦Cºû¤Gºû°}¦C
    
18.         .Sort KEY1:=.Cells(1), Order1:=1, KEY2:=.Cells(2), Order2:=1, Header:=xlYes
    
19.     End With
    
20. End Sub

½Æ»s¥N½X