­ã´£³¡ªL

³o°ÝÃD¥ÎVBAÀ³¸û¾A¦X:

1. Sub TEST()
   
2. Dim R&, xD, Arr, Brr, j&, Jm&, T$, N&
   
3. [L:O].ClearContents
   
4. [L1:O1] = Array("¤é´Á", "¼Ë¦¡", "¤u§@¤H­û", "¼Æ¶q")
   
5. ¡@
   
6. R = Cells(Rows.Count, 1).End(xlUp).Row - 1
   
7. If R < 2 Then Exit Sub
   
8. Arr = [A2:F2].Resize(R)
   
9. ReDim Brr(1 To R, 1 To 4)
   
10. Set xD = CreateObject("Scripting.Dictionary")
    
11. ¡@
    
12. For j = 1 To R
    
13. ¡@¡@T = Arr(j, 1) & Arr(j, 2):  N = xD(T)
    
14. ¡@¡@If N = 0 Then Jm = Jm + 1: xD(T) = Jm:  N = Jm
    
15. ¡@
    
16. ¡@¡@Brr(N, 1) = Arr(j, 1): Brr(N, 2) = Arr(j, 2)
    
17. ¡@¡@If InStr(Brr(N, 3), Arr(j, 4)) = 0 Then
    
18. ¡@¡@¡@¡@Brr(N, 3) = Trim(Brr(N, 3) & " " & Arr(j, 4))
    
19. ¡@¡@End If
    
20. ¡@¡@Brr(N, 4) = Brr(N, 4) + Val(Arr(j, 6))
    
21. Next j
    
22. [L2:O2].Resize(Jm) = Brr
    
23. End Sub

½Æ»s¥N½X

­ã´£³¡ªL

¦^´_ 3# mark761222

ªá­Ó®É¶¡¬ã¨s¬Ý¬Ý, ¤£Ãø¡G(µ{¦¡¦³³¡¥÷­×§ï)

1. Sub TEST()
   
2. Dim R&, xD, Arr, Brr, j&, Jm&, T$, N&
   
3. '¡õ²M°£¤§«eªºµ²ªG
   
4. [L:O].ClearContents
   
5. [L1:O1] = Array("¤é´Á", "¼Ë¦¡", "¤u§@¤H­û", "¼Æ¶q")¡@
   
6. ¡@
   
7. '¡õ¥H¢ÏÄæ¨ú±o³Ì«á¤@µ§¡e¦C¸¹¡f
   
8. R = Cells(Rows.Count, 1).End(xlUp).Row
   
9. If R < 2 Then Exit Sub
   
10. ¡@
    
11. '¡õ±N¸ê®Æ½d³ò³]¬°°}¦C¡]§t¼ÐÃD¦C¡^
    
12. Arr = [A1:F1].Resize(R)
    
13. ¡@
    
14. '¡õ³]¤@­ÓªÅ°}¦C¡A¥H±µ¨üµ²ªG
    
15. ReDim Brr(1 To R, 1 To 4)
    
16. ¡@
    
17. '¡õ³]¤@­Ó¦r¨åÀÉ¡A¥H°ß¤@¡e¯Á¤Þ­È¡f¦¬¶°¬ÛÃö¼Æ¾Ú
    
18. Set xD = CreateObject("Scripting.Dictionary")
    
19. ¡@
    
20. For j = 2 To R
    
21. ¡@¡@'¡õ¢Ï&¢ÐÄæ¤å¦r¦X¬°¡e¯Á¤Þ­È¡f
    
22. ¡@¡@T = Arr(j, 1) & Arr(j, 2)
    
23. ¡@
    
24. ¡@¡@'¡õ¨ú¥X¡e¯Á¤Þ­È¡f¦b¦r¨åÀɤ¤©Ò±aªº¡e§Ç¸¹¡f¡A
    
25. ¡@¡@¡@³o¡e§Ç¸¹¡f¥Î¨ÓÃѧO¶ñ¤J¡e°}¦C¡fªº¡e¦ì¸m¡f
    
26. ¡@¡@N = xD(T)¡@
    
27. ¡@
    
28. ¡@¡@'¡õ¦pªG¡e§Ç¸¹¡f¬°¢¯¡Aªí¥Ü¬O·sªº¡e¯Á¤Þ­È¡f¡A
    
29. ¡@¡@¡@±N¡e§Ç¸¹¡f»¼¼W¢°¡A¦A¯Ç¤J¦r¨åÀÉ
    
30. ¡@¡@If N = 0 Then Jm = Jm + 1: xD(T) = Jm:  N = Jm
    
31. ¡@
    
32. ¡@¡@'¡õ¶ñ¤J¡e¤é´Á¡D¼Ë¦¡¡f
    
33. ¡@¡@Brr(N, 1) = Arr(j, 1): Brr(N, 2) = Arr(j, 2)
    
34. ¡@
    
35. ¡@¡@'¡õ¶ñ¤J¡e¤u§@¤H­û¡f¡AInStr ¥Î¨Ó§PÂ_¬O§_­«ÂÐ
    
36. ¡@¡@If InStr(Brr(N, 3), Arr(j, 4)) = 0 Then
    
37. ¡@¡@¡@¡@Brr(N, 3) = Trim(Brr(N, 3) & " " & Arr(j, 4))
    
38. ¡@¡@End If
    
39. ¡@
    
40. ¡@¡@'¡õ¶ñ¤J¡e²Ö­p¼Æ¶q¡f
    
41. ¡@¡@Brr(N, 4) = Brr(N, 4) + Val(Arr(j, 6))
    
42. Next j
    
43. ¡@
    
44. '¡õ¦C¥Xµ²ªG
    
45. [L2:O2].Resize(Jm) = Brr
    
46. End Sub

½Æ»s¥N½X

­ã´£³¡ªL

¦^´_ 5# mark761222


[A:B]¡@»PRange("A:B") ¦P¸q
[A2:B5]¡@»PRange("A2:B5") ¦P¸q

¨ä¥¦°ÝÃD­Y­n»¡©ú¡A¥i¯à¼g¦n´X­¶¤]¤£¤@©w¯à»¡©ú¥Õ¡A
¶R®Ñ©Î¦h¬Ý½×¾Âªº¸ê®Æ¡AºCºC¶i¶¥§a¡I