- ©«¤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
|
ÁÂÁ½׾Â,ÁÂÁ¦U¦ì«e½ú
«á¾ÇÂǦ¹©«½m²ßVBA°}¦C»y¦r¨å,¾Ç²ß¤è®×¦p¤U,½Ð¦U¦ì«e½ú«ü±Ð
°õ¦æ«e:
°õ¦æµ²ªG:
Option Explicit
Sub TEST()
Dim Brr, V, Y, R&, i&, T$, M%, K%
'¡ô«Å§iÅܼÆ
Set Y = CreateObject("Scripting.Dictionary")
'¡ô¥OYÅܼƬO ¦r¨å
Brr = Range([A1], Cells(Rows.Count, "A").End(xlUp))
'¡ô¥OBrrÅܼƬO ¤Gºû°}¦C,¥HAÄæÀx¦s®æȱa¤J°}¦C¤¤
For i = 2 To UBound(Brr)
'¡ô³]¶¶°j°é
T = Left(Brr(i, 1), 2)
'¡ô¥OTÅܼƬO¥ªÃä2¦rªº¦r¦ê
K = Right(Brr(i, 1), 3)
'¡ô¥OKÅܼƬO¥kÃä3¦rÂର¼ÆÈ(¦]¬°K«Å§i¬O¼ÆÈ)
M = Y(T)
'¡ô¥OMÅܼƬOTÅܼƬdY¦r¨å±o¨ìitem,
'¤@¶}©lY¦r¨å¸Ì¨S¦³¦¹key®É,item¬Oªì©lÈÂà¾ã¼Æ=0,
'¦]¬°M«Å§i¬O¾ã¼ÆÈ
If M < K Then M = K
'¡ô³o¬On¤ñ¸û¥X³Ì¤jÈ
Y(T) = M
'¡ô¥O¥HTÅܼƷíkey,item¬O·í¤Uªº³Ì¤jÈ©ñ¦^¦r¨å
Next
For Each V In Y.KEYS
'¡ô³]³v¶µ°j°é!¥OVÅܼƬO Y¦r¨åªºkey
R = R + 1
'¡ô¥ORÅܼƲ֥[ 1
Brr(R, 1) = V & Format(Y(V), "000")
'¡ô¥O¥H²Õ¦X¦r¦ê(µ²ªG¸ê®Æ)Âл\±¼ìBrr°}¦CÈ,
'²¦³ºBrrªºì¸ê®Æ¤w¸g¥Î¤£¨ì¤F,
'¦p¦¹´N¤£¥²¦A³]¤@Ó°}¦C¸Ëµ²ªG¸ê®Æ
'¦ý¬O»Ýn·Ç½Tªºª¾¹Dµ²ªG¸ê®Æ¨ì°}¦Cªºþ¤@¦C,¦pRÅܼƩÎY.Count
Next
[J2].Resize(Y.Count, 1) = Brr
'¡ô¥OBrr§½³¡¸ê®Æ(µ²ªG¸ê®Æ)¼g¤JÀx¦s®æ¤¤,¶W¹L¦¹½d³òªºBrr°}¦CÈ©¿²¤
Set Y = Nothing: Erase Brr
'¡ô¥OÄÀ©ñÅܼÆ
End Sub |
|