§PÂ_¦¡¥X²{0,¦h¾lªºªÅ¥Õ

mark761222

¤U¸ü (102.2 KB)

2015-9-25 23:39

1.¹Bºâ¤¸¦h¾lªºªÅ¥Õ¦p¦ó²M°£  «e´£¤u§@¤H­û:½s¸¹¤¤¶¡­n¦³ªÅ®æ©Î¬O¡B¹j¶}    ¦p S01¡BS02¡BS03
2.¨S¸ê®Æ·|²£¥Í0
3.§PÂ_¦¡³]©wªÅ¥Õ¾É­P¨S¸ê®Æ·|²£¥Í0¡A¦p¦ó¤£²£¥Í0

³Â·Ð¦U¦ì¤j¤jÀ°¦£¸Ñµª¡A©Î´£¥X¦n·N¨£
³o°ÝÃD§x´b¦n¤[

ªþ¥ó¦³§Ú°ÝÃDÀÉ®×
TEST01.rar (13.24 KB)

¤U¸ü¦¸¼Æ: 11

2015-9-25 23:40

­ã´£³¡ª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

mark761222

TO ­ã´£³¡ªL
ÁÂÁ§Aªº¸Ñµª¯uªº¦¨¥\¤F
¥i¬O¤j¤j§Aªºµ{¦¡½X¹ï§Ú¨Ó»¡¦³ÂIÃø«×¡A¤£ª¾¹D¯à¤£¯à½Ð§AÀ°­Ó¦£¡Aµ{¦¡«á­±À°¦£µù¸Ñ¤@¤U
¡AÅý§Ú§ó¶i¤@¨Bªº¾Ç²ß©O?
«ô°U¤F

­ã´£³¡ª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

mark761222

¦³´X­Ó°ÝÃD­n½Ð±Ðª©¤j
©êºp°Ý³o»ò¦h°ÝÃD

°ÝÃD¤@
R& «á­±ªº&»P$¥Nªíªº²[¸q¬O?

°ÝÃD¤G
[L:O].ClearContents
[L1:O1] = Array("¤é´Á", "¼Ë¦¡", "¤u§@¤H­û", "¼Æ¶q")

[L:O]»P[L1:O1] ³o¬OÄÝ©ó°}¦C¶Ü?
[L:O]¬O¤£¬O±aªí[L~¨ì¼Æ¦r¥ô¦ó¼Æ:O~¨ì¥ô¦ó¼Æ]
©Ò¥H©³¤U°²¦p¦³[L1:O1]¡B[L2:O2]¡B[L3:O3]³£¥i¥H²M°£¶Ü?

°ÝÃD¤T
'¡õ±N¸ê®Æ½d³ò³]¬°°}¦C¡]§t¼ÐÃD¦C¡^
Arr = [A1:F1].Resize(R)

Resize(R)   <³o­ÓR¥Nªí¬O¤°»ò·N«ä?

°ÝÃD¥|
¡@¡@T = Arr(j, 1) & Arr(j, 2)
¡@
¡@¡@'¡õ¨ú¥X¡e¯Á¤Þ­È¡f¦b¦r¨åÀɤ¤©Ò±aªº¡e§Ç¸¹¡f¡A
¡@¡@¡@³o¡e§Ç¸¹¡f¥Î¨ÓÃѧO¶ñ¤J¡e°}¦C¡fªº¡e¦ì¸m¡f
¡@¡@N = xD(T)¡@
¬A¸¹¤¤ªºT¸ò¤W­±¨º­ÓT¦³¬ÛÃö©Ê¶Ü?

­ã´£³¡ª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

mark761222

¦^´_ 6# ­ã´£³¡ªL


    ÁÂÁ¡A§Ú¬d¤F³\¦hºô¯¸¡A¤w¸g±Nµ{¦¡¤j·§¬ÝÀ´¤F¡A¦³³¡¤ÀÁÙ¬O¤£À´»Ý­n¤@¬q®É¶¡®ø¤Æ¤@¤U¡A·PÁ§Aªº«ü¾É

mark761222

³oÃä¤À¨Éµ¹¤j®a¤@¤U
Dim R&  ¡A&¥Nªíªø¾ã¼Æ
Dim T$   ¡A$¥Nªí¦r¦ê
¥H¤W¬O§Ö³t¼gªk
[L:O].ClearContents               ²M°£[L:O]©Ò¦³¸ê®Æ
[L1:O1] = Array("¤é´Á", "¼Ë¦¡", "¤u§@¤H­û", "¼Æ¶q")¡@  ±N¤é´Á¡A¼Ë¦¡¡A¤u§@¤H­û¡A¼Æ¶q¼g¨ìÀx¦s®æ·í¤¤
R = Cells(Rows.Count, 1).End(xlUp).Row   ±N¨ú±o³Ì«á¤@µ§ªº¸ê®Æ¶Çµ¹R(¥H¢ÏÄæ¨ú±o³Ì«á¤@µ§¡e¦C¸¹¡f)
«á­±·|³°Äò¸É¤W¡A¦b¦£

Andy2483

¦^´_ 2# ­ã´£³¡ªL


    ÁÂÁ½׾Â,ÁÂÁ«e½ú
«á¾ÇÂǦ¹©«½m²ß°}¦C»P¦r¨å,¾Ç²ß¤è®×¦p¤U,½Ð«e½ú¦A«ü¾É

°õ¦æ«e:

¤U¸ü (54.75 KB)

2023-5-9 09:18

°õ¦æµ²ªG:

¤U¸ü (65.08 KB)

2023-5-9 09:19

Option Explicit
Sub TEST_1()
Dim Brr, Y, A, i&, j%, Ta$, Tb$, Td$, TT$
'¡ô«Å§iÅܼÆ
Set Y = CreateObject("Scripting.Dictionary")
'¡ô¥OYÅܼƬO¦r¨å
Brr = Range([F1], [A65536].End(3))
'¡ô¥OÅܼƬO¤Gºû°}¦C¨Ã¥HÀx¦s®æ­È­Ë¤J
A = Array(, 1, 2, 4, 6)
'¡ô³]­Ó¤@ºû°}¦CÅý«áÄòªºµ²ªG°j°é§ì¨ú«ü©wÄæ¦ì
For i = 1 To UBound(Brr)
'¡ô³]¶¶°j°é
   Ta = Brr(i, 1): Tb = Brr(i, 2): Td = Brr(i, 4): TT = Ta & "|" & Tb
   If Y(TT) = "" Then
   '¡ô³oºÃ°Ý¥y¤w¸g¤£ª¾¤£Ä±±N key¬OTTÅܼÆ,item¬O"" ,¯Ç¤J¦bY¦r¨å¤¤¤F
      Y(TT) = Y.Count
      '¡ô¯Á©Ê´N¨Ì·í¤Ukeyªº¼Æ¶q·íÅܼƬö¿ý¦¹key¦b°}¦C¤¤ªº¯Á¤Þ¦C¸¹
      For j = 1 To 4: Brr(Y.Count, j) = Brr(i, A(j)): Next: GoTo i01
      '¡ô¦]¬°¬O­º¦¸¯Ç¤J¦¹key,©Ò¥H±N¦UÄæ¦ì­È±a¤J«ü©w¦ì¸m,Âл\°}¦C­È,
      '¡ô¥H¤W´N¤w¸g³B²z¤F­º¦¸­È,¤£¥²²Ö¥[¼Æ¶q,©Ò¥H¸õ¨ìi01«ü©w¦ì¸mÄ~Äò°õ¦æ
   End If
   Brr(Y(TT), 4) = Brr(Y(TT), 4) + Brr(i, 6)
   '¡ô¦pªGµ{§Ç¯à¶]¨ì³o¸Ì,¥Nªí¤£¬O­º¦¸,±N¸Ókey©Ò±aªºitem½Õ¥X¨Ó(¯Á¤Þ¦C¸¹),
   'Åý¼Æ¶q°µ²Ö¥[
   If InStr(" " & Brr(Y(TT), 3) & " ", " " & Td & " ") = 0 Then
      Brr(Y(TT), 3) = Trim(Brr(Y(TT), 3) & " " & Td)
   End If
   '¡ô±N¤£­«½Æ¤u§@¤H­û¯Ç¤J
i01: Next
[L:O].ClearContents
'¡ô²M°£µ²ªGÀx¦s®æ¸ê®Æ
If Y.Count > 1 Then [L1].Resize(Y.Count, 4) = Brr
'¡ô¦pªG¦r¨å¸Ìkeys¼Æ>1!´N±q[L1]¶}©l¶K¤JBrr°}¦C§½³¡­È
Set Y = Nothing: Erase Brr
'¡ôÄÀ©ñÅܼÆ
End Sub