- ©«¤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-3-14 10:37 ½s¿è
¦^´_ 12# ã´£³¡ªL
ÁÂÁ«e½ú
«á¾Ç¬ãŪ¦¹©«¾Ç²ß¨ì«Ü¦hª¾ÃÑ,¤ß±oµù¸Ñ¦p¤U,½Ð«e½ú¦A«ü¾É
Option Explicit
Sub TEST_A1()
Dim Arr, Brr, xD, TM, R&, i&, C%, j%, k%, T$, TT$, TC$
'¡ô«Å§iÅܼÆ:(Arr,Brr,xD,TM)¬O³q¥Î«¬ÅܼÆ,(R,i)¬Oªø¾ã¼ÆÅܼÆ,
'(C,j,k)¬Oµu¾ã¼ÆÅܼÆ,(T,TT,TC)¬O¦r¦êÅܼÆ
TM = Timer
'¡ô¥OTM³o³q¥Î«¬ÅܼƬO ·í¤U®É¶¡
R = [®t²§!a1].Cells(Rows.Count, 1).End(xlUp).Row - 3
'¡ô¥OR³oªø¾ã¼ÆÅܼƬO ®t²§ªíAÄæ³Ì«á¤@Ó¦³¤º®eÀx¦s®æ¦C¸¹ -3
C = [®t²§!a4].Cells(1, Columns.Count).End(xlToLeft).Column
'¡ô¥OC³oµu¾ã¼ÆÅܼƬO ®t²§ªí²Ä4¦C³Ì¥k¤@Ó¦³¤º®eÀx¦s®æÄ渹
If R < 2 Or C < 9 Then Exit Sub
'¡ô¦pªGRÅܼÆ<2 ©ÎC<9!´Nµ²§ôµ{¦¡°õ¦æ
'---------------------------------------
Set xD = CreateObject("Scripting.Dictionary")
'¡ô¥OxD³o³q¥Î«¬ÅܼƬO ¦r¨å
Arr = Range([Data!h1], [Data!a1].Cells(Rows.Count, 1).End(xlUp))
'¡ô¥OArr³o³q¥Î«¬ÅܼƬO ¤Gºû°}¦C,¥HData1ªí[H1]¨ìAÄæ³Ì«á¦³¤º®eÀx¦s®æ,
'¦¹½d³ò¦s®æȱa¤JArr°}¦C¤¤
For i = 2 To UBound(Arr)
'¡ô³]¶¶°j°é!i±q2¨ìArr°}¦CÁa¦V³Ì¤j¯Á¤Þ¸¹
For j = 1 To 6
'¡ô³]¶¶°j°é!j±q1¨ì 6
T = T & "|" & Arr(i, Mid(234517, j, 1))
'¡ô¥OT³o¦r¦êÅܼƬO ¦Û¨³s±µ"|"¦A³s±µi°j°é¦CMid()ÄæArr°}¦CÈ
'Mid():234517Ȫº²Ä(jÅܼÆ)¦r¶}©l,¨ú1¦r
Next j
xD(T) = xD(T) + Val(Arr(i, 8)): T = ""
'¡ô¥OTÅܼƦbxD¦r¨å¸ÌªºItemȬO ItemȦۨ¦A + Val()È,
'Val()È:i°j°é¦C²Ä8ÄæArr°}¦CȸgÂà¤Æ¬°¼ÆÈ
'¥OTÅܼƬO ªÅ¦r¤¸
Next i
'-------------------------------------
Arr = [®t²§!a4].Resize(R, C)
'¡ô¥OArr³o³q¥Î«¬Åܼƴ«¸Ë¤J ®t²§ªí[A4]ÂX®i¦V¤URÅܼƦC,¦V¥kCÅܼÆÄæ
ReDim Brr(1 To R - 1, 1 To C - 8)
'¡ô«Å§iBrr³o³q¥Î«¬ÅܼƬO¤Gºû°}¦C,½d³ò¤j¤p:Áa¦V¯Á¤Þ¸¹±q1¨ì RÅܼÆ-1,
'¾î¦V¯Á¤Þ¸¹±q1¨ì CÅܼÆ-8
For i = 2 To R
'¡ô³]¶¶°j°é!i±q2¨ì RÅܼÆ
T = ""
'¡ô¥OTÅܼƬOªÅ¦r¤¸
For j = 1 To 4: T = T & "|" & Arr(i, j): Next j
'¡ô³]¶¶°j°é!j±q1¨ì 4:¥OTÅܼƬO ¦Û¨³s±µ"|"¦A³s±µi°j°é¦Cj°j°éÄæArr°}¦CÈ
For k = 1 To UBound(Brr, 2)
'¡ô³]¶¶°j°é!k±q1¨ì Brr°}¦C¾î¦V³Ì¤j¯Á¤ÞÄ渹
TT = T & "|" & Arr(i, 5) & "|" & Arr(1, k + 8)
'¡ô¥OTT³o¦r¦êÅܼƬOTÅܼƳs±µ"|",Äò±µi°j°é¦C²Ä5ÄæArr°}¦CÈ,¦A³s±µ"|",
'³Ì«á³s±µ1¦C²ÄkÅܼÆ+8Ä檺Arr°}¦CÈ ªº·s¦r¦ê
TC = T & "|®t²§" & "|" & Arr(1, k + 8)
'¡ô¥OTC³o¦r¦êÅܼƬO TÅܼƳs±µ"|®t²§"¦r¦ê,¦A³s±µ"|",
'³Ì«á³s±µ1¦C²ÄkÅܼÆ+8Ä檺Arr°}¦CÈ ªº·s¦r¦ê
If xD.Exists(TT) Then Brr(i - 1, k) = xD(TT): xD(TC) = ""
'¡ô¦pªG¥HTTÅܼƬdxD¦r¨å¬O¦s¦b¦¹key,
'´N¥O(i°j°é¼Æ-1)¦C,K°j°éÄæBrr°}¦CȬO ¥HTTÅܼƬdxD¦r¨åªº¦^¶ÇItemÈ
'¥OTCÅܼƷíKey,Item¬O ªÅ¦r¤¸¯Ç¤JxD¦r¨å¸Ì
If i > 3 And Arr(i, 5) = "®t²§" Then
'¡ô¦pªGi°j°é¼Æ¤j©ó3 ¦Ó¥Bi°j°é¦C²Ä5ÄæArr°}¦CȬO "®t²§"¦r¦ê
If xD.Exists(TC) Then Brr(i - 1, k) = Brr(i - 2, k) - Brr(i - 3, k)
'¡ô¦pªG¥HTCÅܼƬdxD¦r¨å¬O¦s¦b¦¹key,
'´N¥O(i°j°é¼Æ-1)¦CK°j°éÄæBrr°}¦CȬO
'(i°j°é¼Æ-2)¦CK°j°éÄæBrr°}¦CÈ - (i°j°é¼Æ-3)¦CK°j°éÄæBrr°}¦CÈ
End If
Next k
Next i
'-------------------------------------
[®t²§!i5].Resize(R - 1, C - 8) = Brr
'¡ô¥O®t²§ªí[I5]Àx¦s®æÂX®i¦V¤URÅܼÆ-1¦C,¦V¥kÂX®iCÅܼÆ-8Äæ,
'¦¹½d³òÀx¦s®æÈ¥HBrr°}¦Cȱa¤J
Arr = "": Brr = "": Set xD = Nothing
'ÄÀ©ñÅܼÆ
MsgBox Timer - TM
'¡ô¥O¸õ¥X´£¥Üµ¡!Åã¥Ü·í¤U®É¶¡-TMÅܼÆ
End Sub |
|