- ©«¤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-10-21
|
¥»©«³Ì«á¥Ñ Andy2483 ©ó 2023-6-8 16:16 ½s¿è
ÁÂÁ½׾Â,ÁÂÁ¦U¦ì«e½ú
«á¾ÇÂǦ¹©«½m²ß°}¦C»P¦r¨å,¾Ç²ß¤è®×¦p¤U,½Ð¦U¦ì«e½ú«ü±Ð
°õ¦æ«e:
°õ¦æµ²ªG:
Option Explicit
Sub TEST()
Dim Brr, Crr, Z, i&, R&, C%, M&, T$
'¡ô«Å§iÅܼÆ
Set Z = CreateObject("Scripting.Dictionary")
'¡ô¥OZÅܼƬO ¦r¨å
Brr = Range([C2], [A65536].End(3))
'¡ô¥OBrrÅܼƬO ¤Gºû°}¦C,¥HA~CÄæÀx¦s®æȱa¤J
ReDim Crr(1 To UBound(Brr), 1 To 100)
'¡ô¥OCrrÅܼƬO ¤GºûªÅ°}¦C,Áa¦V½d³ò¦PBrr°}¦C,¾î¦V½d³ò1~100
For i = 1 To UBound(Brr)
'¡ô³]¶¶°j°é
T = Brr(i, 3)
'¡ô¥OTÅܼƸˤJ²Ä3Äæ°j°é°}¦CÈ,¤@¤è±©w¸q¬°¦r¦ê,¥t¤@¦n³B¬OÁYµu«á¤èµ{¦¡½X
If Z(T) = "" Then C = C + 1: Z(T) = C: Crr(1, C) = T: Z(T & "|r") = 1
'¡ô±Nº¦¸¯Ç¤JZ¦r¨åªº ¯¸ÂIkey¨Ì§Ç§G¦bCrr°}¦C²Ä1¦C,
'¨Ã¥OZ¦r¨å°O¦í ³o¯¸ÂIkey¬O¦bCrr°}¦CªºþÓÄæ¦ì,
'Z(T & "|r") = 1¬O¬°¤F¼ÐÃD¦CÅý¥X1¦C
R = Z(T & "|r") + 1: Z(T & "|r") = R
Crr(R, Z(T)) = Brr(i, 1)
'¡ô¤£ºÞ ¯¸ÂIkey¬O¤£¬Oº¦¸¯Ç¤JZ¦r¨å,³£À³¸Ó±N §å¸¹¼g¤JCrr¹ïÀ³keyªºÄæ¦ì¤U
If M < R Then M = R
'¡ô³o¬On§P©wCrr°}¦Cn¼g¤JÀx¦s®æ®É,»Ýn¦h¤Ö¦C¼Æ
Next
[E:IV].ClearContents
'¡ô²M°£µ²ªGÄ椺®e
[E1].Resize(M, C) = Crr
'¡ô±q[E1]¶}©lªº½d³ò¼g¤JCrr°}¦CÈ
Set Z = Nothing: Erase Brr
'¡ô¥OÄÀ©ñÅܼÆ
End Sub |
|