- ©«¤l
- 1446
- ¥DÃD
- 40
- ºëµØ
- 0
- ¿n¤À
- 1470
- ÂI¦W
- 0
- §@·~¨t²Î
- Windows 7
- ³nÅ骩¥»
- Excel 2010 & 2016
- ¾\ŪÅv
- 50
- ©Ê§O
- ¨k
- ¨Ó¦Û
- ¥xÆW
- µù¥U®É¶¡
- 2020-7-15
- ³Ì«áµn¿ý
- 2024-11-29
|
ÁÂÁ½׾Â,ÁÂÁ¦U¦ì«e½ú
«á¾ÇÂǦ¹©«½m²ß°}¦C»P¦r¨å¥t¤@¤è®×,¾Ç²ß¤è®×»P¤ß±o¦p¤U,½Ð¦U¦ì«e½ú«ü±Ð
Option Explicit
'³o¤è®×¬O¥H¦r¨åkey°O¿ý¤£«½Æªº³f¸¹,item¬°¤Gºû°}¦C,
'¥t¥H³f¸¹³s±µ"/r"¦r¦ê¬°key,item¬°¸Ó¤Gºû°}¦C¤w¨Ï¥Îªº¦C¼Æ
Sub TEST_2()
Application.DisplayAlerts = False
Dim Brr, Crr(1 To 1000, 1 To 8), Z, Q, A, R&, i&, j%, s%, N%
Set Z = CreateObject("Scripting.Dictionary")
For Each A In Worksheets
If A.Name <> "Á`ªí" Then A.Delete
Next
Brr = [A1].CurrentRegion
For i = 3 To UBound(Brr)
A = Z(Brr(i, 2)): R = Z(Brr(i, 2) & "/r") + 1
'°j°é¤@¶}©l:
'A = Z(Brr(i, 2))³oµ{§Ç°õ¦æ´N¤w¸g¦bZ¦r¨å¸Ì²£¥Í¤Fkey¬O Brr(i, 2)°}¦CÈ,
'¦Ó³o¹ïÀ³item¬OªÅªº,µ{§Ç·N¸q¬O¥O¥HAÅܼƬO °j°é³f¸¹¬°key±Nitem¤Gºû°}¦C´£¨ú¥X¨Ó,
'¦pªGitem¤£¬O¤Gºû°}¦C¤]¨S®t!
'¦]¬°AÅܼƫŧiªº¬O³q¥Î«¬ÅܼÆ,¥i¥HÀH»Ý¨D§@ÅÜ´«(²¦³º¤@¶}©lªº¦r¨å¸Ìþ¨Óªº¤Gºû°}¦C)
'R = Z(Brr(i, 2) & "/r") + 1³oµ{§Ç°õ¦æ«á¤w¸g´N¤w¸g¦bZ¦r¨å¸Ì²£¥Í¤Fkey¬O
'Brr(i, 2)°}¦Cȳs±µ"/r"·s¦r¦ê,¦Ó³o¹ïÀ³item +1,µ{§Ç·N¸q¬O:
'¥ORÅܼƬO ³f¸¹³s±µ"/r"¦r¦êªºkey,item¬O¦Û¨È+1(³o¬On¼g¤J¤Gºû°}¦CªºªÅ¦C¸¹)
'¦Ü¦¹·|¦³ÓºÃ°Ý,AÅܼƳ£ÁÙ¤£¬O°}¦C! þ¸Ì¨ÓªºªÅ¦C??
'AÅܼÆÁÙ¤£¬O°}¦C¤]¨S®t,«á¤èµ{§Ç§PÂ_¦¡·|«Ø¥ß·s¤Gºû°}¦C,
'RÅܼƫŧiªº¬O ªø¾ã¼Æ,¨äªì©lȬO0,¦A+1=1,©Ò¥Hè¦n«ü©w¨än¼g¤JªÅ¦C¸¹¬O²Ä1¦C
If Not IsArray(A) Then A = Crr
'¡ô¦pªGAÅܼƤ£¬O°}¦C,´N¥OA¬O¦PCrrÅܼƪº¤Gºû°}¦C
'¦Ü¦¹¨CÓi°j°é³£¥H³f¸¹·íkey,item¬O¸Ëµ²ªG¸ê®Æªº¤Gºû°}¦C,³f¸¹³s±µ"/r"¦r¦ê°O¿ý¸Ó
'¤Gºû°}¦C¥Î¨ìþ¤@¦C¤F
For j = 1 To 8: A(R, j) = Brr(i, j): Next
Z(Brr(i, 2)) = A: Z(Brr(i, 2) & "/r") = R
Next
'¡ôÂǵ۱N¤Gºû°}¦C¦bitem¸m¤J/´£¨ú/½s¿è/©ñ¦^¹F¨ì¥Øªº,¦Ü©ó¬°¦ón´£¨ú¥X¨Ó¦A½s¿è?
'VBA³W«h:¦r¨å¸Ìªº°}¦Cn½s¿è»Ý´£¨ú¥X¨Ó¦A©ñ¦^,µLªkª½±µ¦b¦r¨å¸Ì½s¿è
For Each A In Z.keys
If Not IsArray(Z(A)) Then GoTo A01
Worksheets.Add.Name = A
[A1:H1].Resize(2) = Brr
[A3].Resize(Z(A & "/r"), 8) = Z(A)
A01: Next
'¡ô³]³v¶µ°j°é±N¦r¨å¸Ìªº¤Gºû°}¦C¼g¤J·s¼W¤u§@ªí¸Ì
End Sub |
|