ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

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

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


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)

³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

TOP

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

TOP

¥»©«³Ì«á¥Ñ ­ã´£³¡ªL ©ó 2015-9-26 19:07 ½s¿è

¦^´_ 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

TOP

¦³´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¦³¬ÛÃö©Ê¶Ü?

TOP

¦^´_ 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

TOP

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


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

TOP

³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¦£

TOP

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


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

°õ¦æ«e:


°õ¦æµ²ªG:



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
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

        ÀR«ä¦Û¦b : ¦h°µ¦h±o¡C¤Ö°µ¦h¥¢¡C
ªð¦^¦Cªí ¤W¤@¥DÃD