ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

[µo°Ý] vba¨Ï¥Î¦h±ø¥ó¥[Á`

¦^´_ 10# yifan2599


¨º¦P时¦³´X­Óª©¥»??
ÁÙ¬O©T©w ª©¥»? + ª©¥»?  ®t²§, ¨C¤T¦æ¤@²Õ??

TOP

¦^´_ 10# yifan2599

Sub TEST_A1()
Dim Arr, Brr, xD, R&, C%, i&, j%, k%, T$, TT$, TC$, TM
TM = Timer
R = [®t²§!a1].Cells(Rows.Count, 1).End(xlUp).Row - 3
C = [®t²§!a4].Cells(1, Columns.Count).End(xlToLeft).Column
If R < 2 Or C < 9 Then Exit Sub
'---------------------------------------
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range([Data!h1], [Data!a1].Cells(Rows.Count, 1).End(xlUp))
For i = 2 To UBound(Arr)
    For j = 1 To 6
        T = T & "|" & Arr(i, Mid(234517, j, 1))
    Next j
    xD(T) = xD(T) + Val(Arr(i, 8)): T = ""
Next i
'-------------------------------------
Arr = [®t²§!a4].Resize(R, C)
ReDim Brr(1 To R - 1, 1 To C - 8)
For i = 2 To R
    T = ""
    For j = 1 To 4: T = T & "|" & Arr(i, j): Next j
    For k = 1 To UBound(Brr, 2)
        TT = T & "|" & Arr(i, 5) & "|" & Arr(1, k + 8)
        TC = T & "|®t²§" & "|" & Arr(1, k + 8)
        If xD.Exists(TT) Then Brr(i - 1, k) = xD(TT):   xD(TC) = ""
        If i > 3 And Arr(i, 5) = "®t²§" Then
           If xD.Exists(TC) Then Brr(i - 1, k) = Brr(i - 2, k) - Brr(i - 3, k)
        End If
    Next k
Next i
'-------------------------------------
[®t²§!i5].Resize(R - 1, C - 8) = Brr
Arr = "": Brr = "": Set xD = Nothing
MsgBox Timer - TM
End Sub


¦A¤£¦æ, µ¹¤F¤G­Ó¤èªk, ¦Û¤v¥h½Õ¾ã!!!

TOP

¦^´_ 12# ­ã´£³¡ªL


   «D±`·PÁ¡A¥¿¦b§V¤O½Õ¾ã¤¤... ^^
¤H¥Í¤£¤@©w²y²y¬O¦n²y¡A¦ý¬O¦³¾ú½mªº±j¥´ªÌ¡AÀH®É³£¥i¥H´§´Î¡C

TOP

¥»©«³Ì«á¥Ñ 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
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

        ÀR«ä¦Û¦b : ·O´d¨S¦³¼Ä¤H¡A´¼¼z¤£°_·Ð´o¡C
ªð¦^¦Cªí ¤W¤@¥DÃD