| ©«¤l1514 ¥DÃD40 ºëµØ0 ¿n¤À1538 ÂI¦W0  §@·~¨t²ÎWindows  7 ³nÅ骩¥»Excel 2010 & 2016 ¾\ŪÅv100 ©Ê§O¨k ¨Ó¦Û¥xÆW µù¥U®É¶¡2020-7-15 ³Ì«áµn¿ý2025-10-30 
 | 
                
| ¥»©«³Ì«á¥Ñ Andy2483 ©ó 2023-6-6 14:09 ½s¿è 
 ÁÂÁ½׾Â,ÁÂÁ¦U¦ì«e½ú
 «á¾ÇÂǦ¹©«½m²ß°}¦C»P¦r¨å,¾Ç²ß¤è®×¦p¤U,½Ð¦U¦ì«e½ú«ü±Ð
 
 °õ¦æ«e:
 
     
 °õ¦æµ²ªG:
 
     
 
 Option Explicit
 '=COUNTIF(B$1:B2,B2):¦^¶Ç ¤W¤èªºÀx¦s®æ½d³ò¤¤¦P·í¦CÀx¦s®æÈªºÓ¼Æ
 '=COUNTIF(B:B,B2):¦^¶Ç ©T©wªºÀx¦s®æ½d³ò¤¤¦P·í¦CÀx¦s®æÈªºÓ¼Æ
 
 Sub TEST() '2Ó°}¦C¤è¦¡
 Dim Brr, Crr, Y, i&, T$, R&, N&
 '¡ô«Å§iÅܼÆ
 Set Y = CreateObject("Scripting.Dictionary")
 '¡ô¥OYÅܼƬO¦r¨å
 Brr = Range([B2], Cells(Rows.Count, "B").End(3))
 '¡ô¥OBrrÅܼƬO ¤Gºû°}¦C,¥HBÄæÀx¦s®æÈ±a¤J
 R = UBound(Brr): ReDim Crr(1 To R, 1 To 2)
 '¡ô¥ORÅܼƬO Brr°}¦CÁa¦V³Ì¤j¯Á¤Þ¦C¸¹,
 '¥OCrrÅܼƬO ¤GºûªÅ°}¦C,Áa¦V½d³ò¦PBrr°}¦C,¾î¦V1~2
 For i = 1 To R: T = Brr(i, 1): N = Y(T) + 1: Crr(i, 1) = N: Y(T) = N: Next
 '¡ô³]¶¶°j°é!¥OTÅܼƬOBrr°}¦CÈ,¥ONÅܼƬO¥HTÅܼƬdY¦r¨åitemȲ֥[1,
 '¥OCrr°}¦C²Ä1Äæ¼g¤JNÅܼÆÈ,¥O¦bY¦r¨å¸ÌTÅܼÆkey¨äitemȬONÅܼÆÈ
 For i = 1 To R: Crr(i, 2) = Y(Brr(i, 1)): Next
 '¡ô³]¶¶°j°é!¥OCrr°}¦C²Ä2Äæ¼g¤J(¥HBrr°}¦CȬdY¦r¨å±o¨ìªºitemÈ)
 [C2].Resize(R, 2) = Crr
 '¡ô¥O±q[C2]¶}©lªº½d³òÀx¦s®æ¼g¤JCrr°}¦CÈ
 End Sub
 
 Sub TEST_1() '1Ó°}¦C¤è¦¡
 Dim Brr, Y, i&, T$, R&, N&
 '¡ô«Å§iÅܼÆ
 Set Y = CreateObject("Scripting.Dictionary")
 '¡ô¥OYÅܼƬO¦r¨å
 Brr = Range([B2], Cells(Rows.Count, "A").End(3))
 '¡ô¥OBrrÅܼƬO ¤Gºû°}¦C,¥HA~BÄæÀx¦s®æÈ±a¤J
 R = UBound(Brr)
 '¡ô¥ORÅܼƬO Brr°}¦CÁa¦V³Ì¤j¯Á¤Þ¦C¸¹
 For i = 1 To R: T = Brr(i, 2): N = Y(T) + 1: Brr(i, 1) = N: Y(T) = N: Next
 '¡ô³]¶¶°j°é!¥OTÅܼƬO²Ä2ÄæBrr°}¦CÈ,¥ONÅܼƬO¥HTÅܼƬdY¦r¨åitemȲ֥[1,
 '¥OBrr°}¦C²Ä1Äæ¼g¤JNÅܼÆÈ(¨ú¥N±¼ì°}¦CÈ),
 '¥O¦bY¦r¨å¸ÌTÅܼÆkey¨äitemȬONÅܼÆÈ
 For i = 1 To R: Brr(i, 2) = Y(Brr(i, 2)): Next
 '¡ô³]¶¶°j°é!¥OBrr°}¦C²Ä2Äæ¼g¤J(¥H²Ä2ÄæBrr°}¦CȬdY¦r¨å±o¨ìªºitemÈ)
 [C2].Resize(UBound(Brr), 2) = Brr
 '¡ô¥O±q[C2]¶}©lªº½d³òÀx¦s®æ¼g¤JBrr°}¦CÈ
 End Sub
 
 A~BÄæ¥HAÄæ¬°°ò·Ç±Æ§Ç«á«·s°õ¦æµ²ªG:
 
     | 
 |