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

[µo°Ý] EXCEL®Ú¾Ú±ø¥ó¿z¿ï

ÁÂÁ½׾Â,ÁÂÁ¦U¦ì«e½ú
«á¾Ç¾Ç²ß°}¦C»P¦r¨å,(³ÎÂû¤û¤M)¤èªk¾Ç²ß¤è®×¦p¤U,½Ð¦U¦ì«e½ú«ü±Ð

°õ¦æ«e:


°õ¦æµ²ªG:



Option Explicit
Sub TEST()
Dim Brr, Crr(1 To 1000, 1 To 3), V, Z, i&, R&, N&, T$
'¡ô«Å§iÅܼÆ
Set Z = CreateObject("Scripting.Dictionary")
'¡ô¥OZÅܼƬO ¦r¨å
Brr = Range([D2], [B65536].End(3))
'¡ô¥OBrrÅܼƬO ¤Gºû°}¦C,¥HB~DÄæÀx¦s®æ­È±a¤J°}¦C¤¤
With [G2].Resize(UBound(Brr), 3)
'¡ô¥H¤U¬OÃö©ó[G2]ÂX®i¦V¤UBrr°}¦CÁa¦V³Ì¤j¯Á¤Þ¦C¸¹,¦V¥kÂX®i3Äæ½d³òÀx¦s®æªºµ{§Ç
   .Value = Brr
   '¡ô¥O¸Ó°Ï°ìÀx¦s®æ­È¬O Brr°}¦C­È
   .Sort KEY1:=.Item(3), Order1:=2, Header:=2, _
         Key2:=.Item(1), Order2:=1, Header:=2, Orientation:=1
   '¡ô¥O¸Ó°Ï°ìÀx¦s®æ°µ±Æ§Ç
   Brr = .Value: .ClearContents: .Offset(0, 5).ClearContents
   '¡ô¥OBrr°}¦C´«¸Ë²±±Æ§Ç¹L«áªº¸Ó°Ï°ìÀx¦s®æ­È,
   '¥Oµ²ªG°Ï°ìÀx¦s®æ²M°£¤º®e

End With
For i = 1 To UBound(Brr)
'¡ô³]¶¶°j°é
   T = Brr(i, 3): V = Z(T)
   '¡ô¥OTÅܼƬO²Ä1Äæ°}¦C­È,VÅܼƬOTÅܼƬdZ¦r¨åªºitem
   If Not IsArray(V) Then V = Crr
   '¡ô¦pªGVÅܼƤ£¬O°}¦C? True´N¥OVÅܼƬOCrr°}¦C
   R = Z(T & "|r") + 1: Z(T & "|r") = R
   '¡ô¥ORÅܼƬOTÅܼƳs±µ"|r"²Õ¦¨ªº·s¦r¦ê¬dZ¦r¨åitem­È+1,
   '¥OTÅܼƳs±µ"|r"²Õ¦¨ªº¦r¦ê¦bZ¦r¨åªºkey,©Ò¹ïÀ³ªºitem¬O RÅܼÆ

   V(R, 1) = R: V(R, 2) = Brr(i, 1): V(R, 3) = Brr(i, 2)
   '¡ô¥OV°}¦C¨Ì§Ç¼g¤J­È
   Z(T) = V
   '¡ô¥OV°}¦C©ñ¦^Z¦r¨å¤¤
Next
For Each V In Z.KEYS
'¡ô³]³v¶µ°j°é!¥OVÅܼƬOZ¦r¨åªºkey
   If Not IsArray(Z(V)) Then GoTo i01
   '¡ô¦pªG¥HVÅܼƬdZ¦r¨å¦^¶Çitem¤£¬O°}¦C? True´N¸õ¨ì¼Ð¥Üi01¦ì¸mÄ~Äò°õ¦æ
   Cells(2, 7 + N * 5).Resize(Z(V & "|r"), 3) = Z(V)
   '¡ô¥O¦r¨å¤¤ªº°}¦Citem¼g¤JÀx¦s®æ¤¤
   N = N + 1
   '¡ô¥ONÅܼƲ֥[1
i01: Next
Set Z = Nothing: Erase Brr, Crr
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

        ÀR«ä¦Û¦b : ­×¦æ­nô½t­×¤ß¡AÂǨƽm¤ß¡AÀH³B¾i¤ß¡C
ªð¦^¦Cªí ¤W¤@¥DÃD