- ©«¤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 ©ó 2022-11-28 14:16 ½s¿è
¦^´_ 18# ã´£³¡ªL
ÁÂÁ jsc0518 «e½úµoªí¦¹¥DÃD»P½d¨Ò
ÁÂÁ 㴣³¡ªL«e½ú«ü¾É
¥H¤U¾Ç²ß«e½úªºµ{¦¡½X¤ß±o,½Ð«e½ú¦A«ü¾É!
'¤£¤F¸ÑÃD·N¤£¬O°ÝÃD!±N«e½úªºµ{¦¡½X¤@¦æ¦æ¾Ç²ß!´N·|ª¾¹DÃD·N!
'¦]¬°«á¾Ç¤£¬On¸Ñµª!¬O¾Ç²ß!
Option Explicit
Sub test_1()
Dim Arr, xD, Brr(), T$, T1$, i&, n%, m%
'¡ô«Å§iÅܼÆ
[02!g:i].ClearContents '¤£²Öp, ³on¥ý²MªÅ
'¡ô¦W¬°"02"ªº¤u§@ªí(¥H¤UºÙ:ªí¤G) G:IÄæ²M°£¤º®e
Set xD = CreateObject("Scripting.Dictionary")
'¡ô¥OxD ¬O¦r¨å
Arr = Range([01!a1], [01!c65536].End(3))
'¡ô¥OArr ¬O°}¦C!ˤJ ¦W¬°"01"¤u§@ªí(¥H¤UºÙ:ªí¤@),
'ªí¤@[A1]¨ìCÄæ³Ì«á¦³¤º®eªº³Ì¤p¤è¥¿°Ï°ìÀx¦s®æ°Ï°ìªºÈ
ReDim Brr(1 To UBound(Arr), 1 To 3)
'¡ô«Å§iBrr°}¦Cªº½d³ò! Áa¦V±q1¨ì Arr°}¦CÁa¦V³Ì¤j¦C¸¹,¾î¦V±q1¨ì3
For i = 2 To UBound(Arr)
'¡ô³]¶¶°j°é±q2¨ì Arr°}¦CÁa¦V³Ì¤j¦C¸¹
T = Arr(i, 2) & "|" & Arr(i, 3)
'¡ô¥OT¦r¦êÅÜ¼Æ ¬O°j°é¦C²Ä¤GÄæArr°}¦C¦ì¸mªºÈ³s±µ "|" ²Å¸¹,
'¦A³s±µ °j°é¦C²Ä¤TÄæArr°}¦C¦ì¸mªºÈ,(¥H¤UºÙ:®Æ¸¹|§å¸¹)
T1 = Arr(i, 1) & "|" & T
'¡ô¥OT1¦r¦êÅÜ¼Æ ¬O°j°é¦C²Ä¤@ÄæArr°}¦C¦ì¸mªºÈ³s±µ "|" ²Å¸¹,
'¦A³s±µ TÅÜ¼Æ (¥H¤UºÙ: ¤é´Á|®Æ¸¹|§å¸¹)
m = xD(T)
'¡ô¥Om¼Æ¦rÅÜ¼Æ ¬O¦r¨å¸Ì ®Æ¸¹|§å¸¹ ¬°key¹ïÀ³ªºitem
'¤@¶}©lm¬Oªì©lÈ0
'¦bi=2®É!¨ä¹ê³o¤@¦æµ{¦¡½X¤w°µ¤F¨â¥ó¨Æ
'1."A123456|R001"³o¦r¦ê¤w¸gÂǥѦ¹¦æµ{¦¡½X§@¬°key,Item¬O¦r¨åªì©lÈ Variant
'2.m=0
'´«Ó¤è¦¡±Ôz:¬d¦r¨å¸ÌKEY¬O "A123456|R001"ªºITEM¬O¤°»ò?§ä±o¨ì´N§âitemµ¹m
'¦pªG¨S³oÓkey! ´N§â³o¦r¦ê·íkey©ñ¶i¦r¨å¸Ì
'¦pªG¯à@¤ßªº¸òµÛ¶°j°é²z¸Ñ!´N·|µo²{ m¥u¬O¥h¬d¦r¨å¬Ý ®Æ¸¹|§å¸¹ ¬O¦bBrr°}¦C²Ä´X¦C
xD(T1) = xD(T1) + 1
'¡ô¥O ¤é´Á|®Æ¸¹|§å¸¹ ¦r¦êÅܼƬ°keyªºitem²Ö¥[1
'¥H«e³£Ä±±o«Ü©_©Ç«e±µ{¦¡½X¤S¨S¦³³oÓÅܼÆ!! ¬°¤°»ò·|¦b³o¸Ì +1 ???
'ì¨Ó¬O¥H«e³£¨S¦³Åܼƪì©lȪºÆ[©À!©Ò¥H³£¬Ý¤£À´!
'¤£¬O«Å¤£«Å§iªº°ÝÃD! ¤£Àˬd«Å§iÅܼÆOption Explicit ,¤£«Å§iµ{¦¡½XÁÙ¬O·|¶]!
'¥u¬O³Q»{©w¬O³q¥ÎÅܼÆ!¨Ï¥Î³oÓÅܼƨӰµ¼Æ¾Ç¹Bºâ,¥L´N¬O¼Æ¦r.....
'¨S¦³¥¿²Î¾Ç²ß,¾q¶wªº¸ê½è´N±q¾Ç²ß¸ò¿ù»~¤¤¨D¶i¨B!
'¦r¨å¦n¹³¤]¥i¥H«Å§i¥L¥u¸Ë¼Æ¦r©Î¦r¦ê!¦A¾Ç²ß¨ä¥L©«¤l´N¦³¾÷·|¾Ç¨ì¤F!
'ÁÂÁ½׾Â!ÁÂÁ¦U¦ì«e½ú!
'©Ò¥H xD(T1) = xD(T1) + 1 ¥u¬O¦b½T©w ¤é´Á|®Æ¸¹|§å¸¹ ¬O¤£¬O¥þ·s²Õ¦X!«á¤è±Æ°£«½Æ! @2
If m = 0 Then
'¡ô¦pªGm¼Æ¦rÅܼƬO0 ??(°j°é¶]¨ì ®Æ¸¹|§å¸¹ ¬O²Ä¤@¦¸¦b¦r¨å¸Ì¬d³okey m¤~·|¬O0)
n = n + 1
'¡ô¥On¼Æ¦rÅܼƶ}©l²Ö¥[1 ³o¬On©ñBrr°}¦Cµ²ªGªº¦C¦ì,¦p¤U¤è @1¼Ðµù¦ì¸m
'¤@¶}©lnªì©lȬO0
'³o¬On·s¼W¤@µ§ ¥þ·s²Õ¦Xªº ®Æ¸¹|§å¸¹ ©ñBrr°}¦Cµ²ªGªº¦C¦ì
m = n
'¡ô¥O m¼Æ¦rÅܼÆÈ=n¼Æ¦rÅܼÆÈ
'n¬OnÄ~Äò²Ö¥[!
'©Ò¥H¤]n¦³ÓÅܼÆ,¸Ë²{¦b°j°é ®Æ¸¹|§å¸¹ ©ñBrr°}¦Cµ²ªGªº¦C¦ì ªº¦C¸¹
xD(T) = n
'¡ô¥O¥H ®Æ¸¹|§å¸¹ ÅܼƬ°keyªºitem= nÅܼÆÈ
Brr(n, 1) = Arr(i, 2) '@1
'¡ô±N°j°é¦C²Ä¤GÄæArr°}¦C¦ì¸mªºÈˤJ Brr°}¦C(n¼Æ¦rÅܼÆȦC,²Ä¤@Äæ)¦ì¸m
Brr(n, 2) = Arr(i, 3) '@1
'¡ô±N°j°é¦C²Ä¤TÄæArr°}¦C¦ì¸mªºÈˤJ Brr°}¦C(n¼Æ¦rÅܼÆȦC,²Ä¤GÄæ)¦ì¸m
End If
If xD(T1) = 1 Then '@2
'¡ô¦pªG ¤é´Á|®Æ¸¹|§å¸¹ ¦r¦êÅܼƬ°keyªºitem µ¥©ó 1
'ÁöµM«e± ³£¦³§â ®Æ¸¹|§å¸¹ ©ñBrr°}¦Cµ²ªGªº¦C¦ì ªº¦C¸¹m±a¥X¨Ó!
'¦ý¬O ¤é´Á|®Æ¸¹|§å¸¹ ¦pªG«½Æ¤F!³o±ø¥ó¬O¤£·|¦¨¥ßªº!
Brr(m, 3) = Brr(m, 3) + 1
'¡ôÅý Brr°}¦C(m¼Æ¦rÅܼÆȦC,²Ä¤TÄæ)¦ì¸mªºÈ²Ö¥[1
End If
Next
[02!g1:i1] = [{"®Æ¸¹","§å¸¹","¤Ñ¼Æ"}]
'¡ô¥Oªí¤GÀx¦s®æ[G1:I1]¨Ì§ÇˤJ¼ÐÃD "®Æ¸¹","§å¸¹","¤Ñ¼Æ"
'¤S¾Ç¨ì¤F!¥H«e³£¥u·| [02!G1:I1] = Array("®Æ¸¹", "§å¸¹", "¤Ñ¼Æ")
With [02!g2].Resize(n, 3)
'¡ô¥H¤U¬OÃö©óªí¤G[G2]Àx¦s®æ¦V¤UÂX®in¦C,¦V¥kÂX®i3Ä檺½d³òÀx¦s®æ(¥H¤UºÙ:µ²ªG®æ)
.Value = Brr
'¡ô§âBrr°}¦CªºÈˤJµ²ªG®æ
.Sort KEY1:=.Item(1), Order1:=1, _
Key2:=.Item(2), Order2:=1, Header:=2
'¡ôµ²ªG®æ°µ±Æ§Ç
'¥H«e³£¥H¬°¬O«ü©wþ¤@Àx¦s®æ°µKEY1:,«ü©wþ¤@Àx¦s®æ°µKEY2:
'ì¨Ó¬O§ì±Æ§ÇÀx¦s®æªºÄæ¦ì¦Ó¤w
End With
End Sub
Sub ¤G¼h¦¸_º¥¼W±Æ§Ç()
Dim xA
Set xA = [G2:I7]
xA.Sort _
KEY1:=xA.Item(1), Order1:=xlAscending, _
Key2:=xA.Item(2), Order2:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, SortMethod:=xlStroke, _
DataOption1:=xlSortNormal, _
DataOption2:=xlSortNormal
End Sub |
|