Andy2483

回復 8# 准提部林


    謝謝論壇,謝謝前輩
後學藉此帖學習前輩的方案,方案學習心得註解如下,請前輩再指導

執行前:

下載 (48.15 KB)

2023-6-9 09:00

執行結果:

下載 (150.78 KB)

2023-6-9 09:01

Sub TEST()
Dim R&, N&, Arr, Brr, xD, T$, i&
'↑宣告變數
Sheets("Sheet2").UsedRange.Offset(1, 0).EntireRow.Delete
'↑令結果表標題列以下有使用的列刪除
Arr = Sheets("Sheet1").UsedRange
'↑令Arr變數是 二維陣列,以表1有使用格擴展最小方正區域儲存格值帶入陣列中
ReDim Brr(1 To UBound(Arr), 1 To 8)
'↑令Brr變數是 二維空陣列(縱向範圍同Arr陣列,橫向1~8)
Set xD = CreateObject("Scripting.Dictionary")
'↑令xD變數是 字典
For i = 3 To UBound(Arr)
'↑設順迴圈
    If Arr(i, 4) = "" Or Arr(i, 7) = "" Or Arr(i, 8) = "" Or Arr(i, 10) = "" Then GoTo 101
    '↑如果第(4,7,8,10)欄迴圈列Arr陣列值任一個是空的,就跳到標示 101位置繼續執行
    T = Arr(i, 7) & "<" & Arr(i, 10) & ">" & Arr(i, 8) & "|" & Arr(i, 4)
    '↑令T變數是Arr陣列值的組合字串
    R = xD(T)
    '↑令R變數是 T變數查xD字典item值
    If R = 0 Then
    '↑如果R變數是 0(初始值:代表T變數可能是初次納入字典)
       N = N + 1: R = N: xD(T) = N
       '↑令N變數累加1,令R變數是 N變數值(放結果在Brr陣列的列號),
       '令在xD字典的T變數key,對應的item變成 N變數值
       Brr(R, 1) = Arr(i, 7)
       Brr(R, 2) = Arr(i, 8)
       Brr(R, 3) = Arr(i, 10)
       Brr(R, 7) = Arr(i, 4)
       Brr(R, 8) = Split(T, "|")(0)
       '↑令Arr陣列值寫入Brr陣列中
    End If
    If Val(Arr(i, 14)) <> 0 Then Brr(R, 4) = Brr(R, 4) + Arr(i, 14)
    If Val(Arr(i, 21)) <> 0 Then Brr(R, 5) = Brr(R, 5) + Arr(i, 21)
    If Val(Arr(i, 22)) <> 0 Then Brr(R, 6) = Brr(R, 6) + Arr(i, 22)
    '↑如果Arr陣列值確認是非0的數值? True就給Brr陣列加總
101: Next i
If N > 0 Then [Sheet2!A2].Resize(N, 8) = Brr
'↑如果表1有符合條件的資料? 是就令從表2的[A2]開始的範圍寫入Brr陣列值,
'超過範圍的陣列值忽略
End Sub