准提部林

回復 10# yifan2599


那同时有幾個版本??
還是固定 版本? + 版本?  差異, 每三行一組??

准提部林

回復 10# yifan2599

Sub TEST_A1()
Dim Arr, Brr, xD, R&, C%, i&, j%, k%, T$, TT$, TC$, TM
TM = Timer
R = [差異!a1].Cells(Rows.Count, 1).End(xlUp).Row - 3
C = [差異!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 = [差異!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 & "|差異" & "|" & Arr(1, k + 8)
        If xD.Exists(TT) Then Brr(i - 1, k) = xD(TT):   xD(TC) = ""
        If i > 3 And Arr(i, 5) = "差異" Then
           If xD.Exists(TC) Then Brr(i - 1, k) = Brr(i - 2, k) - Brr(i - 3, k)
        End If
    Next k
Next i
'-------------------------------------
[差異!i5].Resize(R - 1, C - 8) = Brr
Arr = "": Brr = "": Set xD = Nothing
MsgBox Timer - TM
End Sub


再不行, 給了二個方法, 自己去調整!!!

yifan2599

回復 12# 准提部林


   非常感謝，正在努力調整中... ^^

Andy2483

回復 12# 准提部林


    謝謝前輩
後學研讀此帖學習到很多知識,心得註解如下,請前輩再指導

Option Explicit
Sub TEST_A1()
Dim Arr, Brr, xD, TM, R&, i&, C%, j%, k%, T$, TT$, TC$
'↑宣告變數:(Arr,Brr,xD,TM)是通用型變數,(R,i)是長整數變數,
'(C,j,k)是短整數變數,(T,TT,TC)是字串變數
TM = Timer
'↑令TM這通用型變數是 當下時間
R = [差異!a1].Cells(Rows.Count, 1).End(xlUp).Row - 3
'↑令R這長整數變數是 差異表A欄最後一個有內容儲存格列號 -3
C = [差異!a4].Cells(1, Columns.Count).End(xlToLeft).Column
'↑令C這短整數變數是 差異表第4列最右一個有內容儲存格欄號
If R < 2 Or C < 9 Then Exit Sub
'↑如果R變數<2 或C<9!就結束程式執行
'---------------------------------------
Set xD = CreateObject("Scripting.Dictionary")
'↑令xD這通用型變數是 字典
Arr = Range([Data!h1], [Data!a1].Cells(Rows.Count, 1).End(xlUp))
'↑令Arr這通用型變數是 二維陣列,以Data1表[H1]到A欄最後有內容儲存格,
'此範圍存格值帶入Arr陣列中
For i = 2 To UBound(Arr)
'↑設順迴圈!i從2到Arr陣列縱向最大索引號
    For j = 1 To 6
    '↑設順迴圈!j從1到 6
        T = T & "|" & Arr(i, Mid(234517, j, 1))
        '↑令T這字串變數是 自身連接"|"再連接i迴圈列Mid()欄Arr陣列值
        'Mid():234517值的第(j變數)字開始,取1字
    Next j
    xD(T) = xD(T) + Val(Arr(i, 8)): T = ""
    '↑令T變數在xD字典裡的Item值是 Item值自身再 + Val()值,
    'Val()值:i迴圈列第8欄Arr陣列值經轉化為數值
    '令T變數是 空字元
Next i
'-------------------------------------
Arr = [差異!a4].Resize(R, C)
'↑令Arr這通用型變數換裝入 差異表[A4]擴展向下R變數列,向右C變數欄
ReDim Brr(1 To R - 1, 1 To C - 8)
'↑宣告Brr這通用型變數是二維陣列,範圍大小:縱向索引號從1到 R變數-1,
'橫向索引號從1到 C變數-8
For i = 2 To R
'↑設順迴圈!i從2到 R變數
    T = ""
    '↑令T變數是空字元
    For j = 1 To 4: T = T & "|" & Arr(i, j): Next j
    '↑設順迴圈!j從1到 4:令T變數是 自身連接"|"再連接i迴圈列j迴圈欄Arr陣列值
    For k = 1 To UBound(Brr, 2)
    '↑設順迴圈!k從1到 Brr陣列橫向最大索引欄號
        TT = T & "|" & Arr(i, 5) & "|" & Arr(1, k + 8)
        '↑令TT這字串變數是T變數連接"|",續接i迴圈列第5欄Arr陣列值,再連接"|",
        '最後連接1列第k變數+8欄的Arr陣列值 的新字串
        TC = T & "|差異" & "|" & Arr(1, k + 8)
        '↑令TC這字串變數是 T變數連接"|差異"字串,再連接"|",
        '最後連接1列第k變數+8欄的Arr陣列值 的新字串
        If xD.Exists(TT) Then Brr(i - 1, k) = xD(TT):   xD(TC) = ""
        '↑如果以TT變數查xD字典是存在此key,
        '就令(i迴圈數-1)列,K迴圈欄Brr陣列值是 以TT變數查xD字典的回傳Item值
        '令TC變數當Key,Item是 空字元納入xD字典裡
        If i > 3 And Arr(i, 5) = "差異" Then
        '↑如果i迴圈數大於3 而且i迴圈列第5欄Arr陣列值是 "差異"字串
           If xD.Exists(TC) Then Brr(i - 1, k) = Brr(i - 2, k) - Brr(i - 3, k)
           '↑如果以TC變數查xD字典是存在此key,
           '就令(i迴圈數-1)列K迴圈欄Brr陣列值是
           '(i迴圈數-2)列K迴圈欄Brr陣列值  -  (i迴圈數-3)列K迴圈欄Brr陣列值
        End If
    Next k
Next i
'-------------------------------------
[差異!i5].Resize(R - 1, C - 8) = Brr
'↑令差異表[I5]儲存格擴展向下R變數-1列,向右擴展C變數-8欄,
'此範圍儲存格值以Brr陣列值帶入
Arr = "": Brr = "": Set xD = Nothing
'釋放變數
MsgBox Timer - TM
'↑令跳出提示窗!顯示當下時間-TM變數
End Sub