Hsieh

¦^´_ 1# wsx24680


   ¤£ª¾¬O¤£¬O³o­Ó·N«ä

1. Sub Ex_1() 'Sheet2¸òSheet3¬Û¥[
   
2. Dim A As Range
   
3. Set d = CreateObject("Scripting.Dictionary")
   
4. d("Item") = Array("ITEM", "NO.", "COUNT")
   
5. For Each Sh In Sheets(Array("Sheet2", "Sheet3"))
   
6. With Sh
   
7. For Each A In .Range(.[A2], .[A65536].End(xlUp))
   
8.   If IsEmpty(d(A & A.Offset(, 1))) Then
   
9.      d(A & A.Offset(, 1)) = Array(A, A.Offset(, 1), A.Offset(, 2))
   
10.      Else
    
11.      ar = d(A & A.Offset(, 1))
    
12.      ar(2) = ar(2) + A.Offset(, 2)
    
13.      d(A & A.Offset(, 1)) = ar
    
14.   End If
    
15. Next
    
16. End With
    
17. Next
    
18. With Sheet3.[F1].Resize(d.Count, 3)
    
19. .Value = Application.Transpose(Application.Transpose(d.items))
    
20. .Sort key1:=.Cells(1, 1), Header:=xlYes
    
21. End With
    
22. End Sub
    
23. 
    
24. 
    
25. Sub Ex_2() 'Sheet1­p¼Æ
    
26. Dim A As Range
    
27. Set d = CreateObject("Scripting.Dictionary")
    
28. With Sheet1
    
29. d("Item") = Array("ITEM", "NO.", "COUNT")
    
30. For Each A In .Range(.[A2], .[A65536].End(xlUp))
    
31.   If IsEmpty(d(A & A.Offset(, 1))) Then
    
32.      d(A & A.Offset(, 1)) = Array(A, A.Offset(, 1), 1)
    
33.      Else
    
34.      ar = d(A & A.Offset(, 1))
    
35.      ar(2) = ar(2) + 1
    
36.      d(A & A.Offset(, 1)) = ar
    
37.   End If
    
38. Next
    
39. End With
    
40. With Sheet1.[F1].Resize(d.Count, 3)
    
41. .Value = Application.Transpose(Application.Transpose(d.items))
    
42. .Sort key1:=.Cells(1, 1), key2:=.Cells(1, 2), Header:=xlYes
    
43. End With
    
44. End Sub

½Æ»s¥N½X

Hsieh

¦^´_ 3# wsx24680


    ¦pªGµ²ªG¬O§A­nªº
¸Õ¸Õ¼Ï¯Ã¤ÀªR¤Î¸ê®Æ·JÁ`¥\¯à

Hsieh

¦^´_ 6# wsx24680

1. Sub Ex_1() 'Sheet2¸òSheet3¬Û¥[
   
2. Dim A As Range, Ay()
   
3. Set d = CreateObject("Scripting.Dictionary")
   
4. Set d1 = CreateObject("Scripting.Dictionary")
   
5. 
   
6. For Each Sh In Sheets(Array("Sheet2", "Sheet3"))
   
7. With Sh
   
8. For Each A In .Range(.[A2], .[A65536].End(xlUp))
   
9.   If IsEmpty(d(A & A.Offset(, 1))) Then
   
10.      d(A & A.Offset(, 1)) = Array(A, A.Offset(, 1), A.Offset(, 2))
    
11.      d1(A.Value) = ""
    
12.      Else
    
13.      ar = d(A & A.Offset(, 1))
    
14.      ar(2) = ar(2) + A.Offset(, 2)
    
15.      d(A & A.Offset(, 1)) = ar
    
16.   End If
    
17. Next
    
18. End With
    
19. Next
    
20. With Sheet3
    
21. .Columns("F:H") = ""
    
22. Set A = .[F1]
    
23. For Each ky In d1.keys
    
24.    For Each key1 In d.keys
    
25.       If d(key1)(0) = ky Then
    
26.       ReDim Preserve Ay(s)
    
27.       Ay(s) = d(key1)
    
28.       s = s + 1
    
29.       End If
    
30.     Next
    
31. With A.Resize(s, 3)
    
32. .Value = Application.Transpose(Application.Transpose(Ay))
    
33. .Sort key1:=.Cells(1, 2), header:=xlNo
    
34. End With
    
35. Erase Ay: s = 0: Set A = .[F65536].End(xlUp).Offset(1, 0)
    
36. Next
    
37. End With
    
38. End Sub

½Æ»s¥N½X

Hsieh

¦^´_ 9# wsx24680


    ar(2) = A.Offset(, 2) + "+" + ar(2)
¦]¬°§A¥«­n¦r¦ê³sµ²
À³¬°ar(2) = A.Offset(, 2) & "+" & ar(2)