- ©«¤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
|
¦^´_ 16# ã´£³¡ªL
ÁÂÁ«e½ú!³o¤ÓÃø¤F!
¥H¤U¤ß±oµù¸Ñ!½Ð«e½ú¦A«ü¾É!
°õ¦æ«e:
°õ¦æµ²ªG:
Option Explicit
Sub TEST()
Dim Arr, Brr, xD, i&, j%, U&, V&, N&, T1$, T2$, T3$, S
S = Timer
'¡ô«Å§iÅܼÆ
[O4:AA20000].Clear
'¡ô±NÀx¦s®æ²M°£
Set xD = CreateObject("Scripting.Dictionary")
'¡ô¥OxD¬O¦r¨å
Arr = Range([M4], Cells(Rows.Count, 1).End(xlUp))
'¡ô¥OArr¬O¦r¨å!ˤJ:[M4]¨ìAÄæ³Ì«á¤@¦³¤º®eÀx¦s®æ¤§¶¡,
'ÂX®i¬°³Ì¤p¤è¥¿°Ï°ìÀx¦s®æªºÈ
ReDim Brr(1 To UBound(Arr), 1 To 13)
'¡ô«Å§iBrrªÅ°}¦C½d³òÁa¦V±q1¨ìArr°}¦CÁa¦V³Ì¤j¦C¼Æ,
'¾î¦V±q1¨ì13Äæ(¨âÓ°}¦C¤j¤p¬Û¦P)
For i = 2 To UBound(Arr)
'¡ô³]¶¶°j°é!±q2 ¨ìArr°}¦CÁa¦V³Ì¤j¦C¼Æ
T1 = Arr(i, 1) '®y¼ÐÄæ
'¡ô¥OT1¬OArr°}¦C°j°é¦C/²Ä¤@ÄæÈ
T2 = Arr(i, 4) 'ÂI¼ÆÄæ
'¡ô¥OT2¬OArr°}¦C°j°é¦C/²Ä¥|ÄæÈ
T3 = Arr(i, 8) 'ÂI¼ÆÄæ
'¡ô¥OT3¬OArr°}¦C°j°é¦C/²Ä¤KÄæÈ
If T1 = "®y¼Ð" Then
'¡ô¦pªGÀx¦s®æ[M4] ¸ÌªºÈ¬O "®y¼Ð" ¦r¦ê??
V = i - 1 '@@
'¡ô±ø¥ó¦¨¥ß´N¥O V°O¾Ð¬O·í¤U°j°é¼Æ -1 ,³o¬On¿ë»{A°Ï³Ì«á¦C¼Æ
GoTo 101
'¡ô±ø¥ó¦¨¥ß´N¸õ¨ì 101¦ì¸mÄ~Äò°õ¦æ
',B°Ï¼ÐÃD¦C!¦¹¦C¤£³B²z
End If
If T1 = "" Or T2 = "" Or T3 = "" Then
'¡ô¦pªG°j°é®y¼Ð °j°éÂI¼Æ °j°éÂI¼Æ¥ô¦ó¤@Ó¬OªÅ¥Õ
GoTo 101
'¡ô±ø¥ó¦¨¥ß´N¸õ¨ì 101¦ì¸mÄ~Äò°õ¦æ,³o¬O¤£³B¸ÌªÅ¥Õ®æ
End If
U = xD(T1 & T2 & T3)
'¡ô¥OU¬O (°j°é®y¼Ð,°j°éÂI¼Æ,°j°éÂI¼Æ)²Õ¦X¦r¦ê_¥H¤UºÙ(²Õ¦X¦r¦ê)¬°keyªºitemÈ
'ªì©lȬO 0
If U = 0 Then
'¡ô¦pªGU ¬Oªì©lȬO 0,¦]¬° U«Å§iªø¾ã¼Æ
xD(T1 & T2 & T3) = i
'¡ô±ø¥ó¦¨¥ß!²Õ¦X¦r¦ê¬°keyˤJxD¦r¨å!itemȬO°j°é¼Æ
'³o¬O¢Ï°Ï¦³¦hµ§¬Û¦P¡A¥u¨ú¤@µ§(B°Ï¦P²z)! ¦C¼Æ°O¾Ð¦b¦r¨åitem¸Ì
GoTo 101
'¡ô±ø¥ó¦¨¥ß´N¸õ¨ì 101¦ì¸mÄ~Äò°õ¦æ
End If
If U > 0 And U <= V Then
'¡ô¦pªGU¤£¬Oªì©lÈ!¤w¸g¦³°j°é¼Æ§@¬° item ¤F
'¦Ó¥BUªº¦C¼Æ¤p©óµ¥©ó(A°Ï³Ì«á¦C¼Æ)!¤]´N¬O¦bA°Ï¦³¥BB°Ï¤]¦³!
xD(T1 & T2 & T3) = -1
'¡ô±ø¥ó¦¨¥ß!´N¥O¦bxD¦r¨å¸Ì¥H²Õ¦X¦r¦ê¬°keyªºitem¬° -1
'³o¸Ìªº -1¬O¤£Åý¼g¤JBrr°}¦C¸Ì
End If
101: Next i
'1.A°Ï/B°Ï¦P®É¦s¦b,ç°£
'2.A°Ï¦³¦hµ§¬Û¦P,¥u¨ú¤@µ§(B°Ï¦P²z)
'¡ô°õ¦æ¥\¯àÁöµM¬O¦p¦¹±Ôz!¦ý«á¾Ç¦bÅÞ¿è¸Ìªº¤ß±o¬O:
'1.1.¥þ³¡°j°é§PÂ_¥u¦³¤@µ§ªº´N¯dµÛ!¦r¨å°O¾Ð©Ò¦b¦C¼Æ!¨SÄa©À!ºÞ¥LA°Ï ©Î B°Ï
'1.2.¥þ³¡°j°é§PÂ_¦³¦hµ§ªº!§ä¨ì¬Û¦Pªº²Ä¤Gµ§¬Ý¬O¤£¬O¦b¦P°Ï,¦b¤£¦P°Ï³oµ§¨â°Ï³£¤£n¤F
For i = 1 To UBound(Arr)
'¡ô³]¥~¶¶°j°é!±q1 ¨ìArr°}¦CÁa¦V³Ì¤j¦C¼Æ
T1 = Arr(i, 1) '®y¼ÐÄæ
'¡ô¥OT1¬OArr°}¦C°j°é¦C/²Ä¤@ÄæÈ
T2 = Arr(i, 4) 'ÂI¼ÆÄæ
'¡ô¥OT2¬OArr°}¦C°j°é¦C/²Ä¥|ÄæÈ
T3 = Arr(i, 8) 'ÂI¼ÆÄæ
'¡ô¥OT3¬OArr°}¦C°j°é¦C/²Ä¤KÄæÈ
U = xD(T1 & T2 & T3)
'¡ô¥OU¬O (°j°é®y¼Ð,°j°éÂI¼Æ,°j°éÂI¼Æ)²Õ¦X¦r¦ê_¥H¤UºÙ(²Õ¦X¦r¦ê)¬°keyªºitemÈ
'ªì©lȬO 0
If T1 = "®y¼Ð" And N > 0 Then
'¡ô³o T1 = "®y¼Ð" ¬On¿ë»{B°Ï¼ÐÃD¦C¼Æ
'¡ô¦pªG°j°é¶]¨ì¤F B°Ï¼ÐÃD¦C¼Æ ¦Ó¥BN > 0 ,N«Å§i¬°ªø¾ã¼Æ!ªì©lȬO 0
',©Ò¥H¤@¶}©l±ø¥ó¬O¤£·|¦¨¥ßªº!³oºØÅÞ¿è¼gªk»Ýn¸õ²æ²´¨£¬°¾ÌªºÆ[©À!
'ÅÞ¿è®Ø¬[·§©À»Ýn½m²ß!µL¤¤¥Í¦³ªºN ¥ýª¾¹Dn¬d«Å§i´N¥i¥H¤F!
'¡ô°j°éªº¤@¶}©l±ø¥ó¬O¤£·|¦¨¥ßªº!
'¦]¬°·íi=1,T1 = "®y¼Ð",N=0 , ·íi=2,N=1,T1 ¤w¸g¤£¬O¦r¦ê "®y¼Ð"
N = V
'¡ôª½¨ìB°Ï¼ÐÃD¦C¶}©l±ø¥ó¦¨¥ß!´N¥ON=V! V:¦b¤W¤è @@¼Ð¥Ü³B
'³o¬OnÅý ¸ê®Æn¼g¤Jµ²ªG°}¦CBrrªº¦C¼Æ ¤Á´«¨ìB°Ï¶}©l²Ö¥[¦C¼Æ¥Îªº
End If
If T1 = "®y¼Ð" Or U = i Then
'¡ô¦pªG°j°é®y¼ÐÄæ¬O "®y¼Ð"¦r¦ê(¼ÐÃD¦C¤]n¼g¶i°}¦CBrr¸Ì)
'©Î ¦pªG²Õ¦X¦r¦ê¬°keyªºitem¬O°j°é¼Æ??
N = N + 1
'¡ô±ø¥ó¦¨¥ß! N´N²Ö¥[ 1,³o¬O¸ê®Æn¼g¤Jµ²ªG°}¦CBrrªº¦C¼Æ
For j = 1 To 13
'¡ô³]¤º¶¶°j°é!±q1 ¨ì 13(Äæ¼Æ)
Brr(N, j) = Arr(i, j)
'¡ôArr°}¦CªºÈˤJBrr°}¦C N¹ïÀ³ªº¦C¦ì/jÄæ¦ì¸Ì
Next
End If
Next i
With [O4:AA4].Resize(UBound(Brr))
'¡ôÃö©ó[O4:AA4]¦V¤U¦J¦CBrr°}¦CÁa¦V³Ì¤j¦C¼Æªº½d³òÀx¦s®æ,¥H¤UºÙ(¦J¦C®æ)
.NumberFormatLocal = "@"
'¡ô¦J¦C®æªº®æ¦¡³]¬° ¤å¦r
.Value = Brr
'¡ôȬOBrr°}¦C¸Ì¹ïÀ³ªºÈ
.Borders.LineStyle = 1
'¡ôÀx¦s®æ®æ½u³]¬° ²Ó¹ê½u
End With
MsgBox Timer - S & " ’"
End Sub |
|