­ã´£³¡ªL

Sub TEST_A1()
Dim Arr, Brr, xD, R&, C%, i&, j%, k%, T$, TT$, 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 5: T = T & "|" & Arr(i, j): Next j
    For k = 1 To UBound(Brr, 2)
        TT = T & "|" & Arr(1, k + 8)
        If xD.Exists(TT) Then Brr(i - 1, k) = xD(TT)
    Next k
Next i
'-------------------------------------
[®t²§!i5].Resize(R - 1, C - 8) = Brr
Arr = "": Brr = "": Set xD = Nothing
MsgBox Timer - TM
End Sub

''¤j¬ù1¬í

­ã´£³¡ªL

Sub TEST_A1()
Dim Arr, Brr, xD, R&, C%, i&, j%, k%, T$, TT$, TS$(2), 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) = ""
           For j = 1 To 2: TS(j) = T & "|ª©¥»" & j & "|" & Arr(1, k + 8): Next j
        End If
        If Arr(i, 5) = "®t²§" Then
           If xD.Exists(TC) Then Brr(i - 1, k) = xD(TS(2)) - xD(TS(1))
        End If
    Next k
Next i
'-------------------------------------
[®t²§!i5].Resize(R - 1, C - 8) = Brr
Arr = "": Brr = "": Set xD = Nothing
MsgBox Timer - TM
End Sub


'®t²§ = ª©¥»2 - ª©¥»1 ???


===========================

­ã´£³¡ªL

¦^´_ 10# yifan2599


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

­ã´£³¡ªL

¦^´_ 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½Õ¾ã!!!