- 帖子
- 1446
- 主題
- 40
- 精華
- 0
- 積分
- 1470
- 點名
- 0
- 作業系統
- Windows 7
- 軟體版本
- Excel 2010 & 2016
- 閱讀權限
- 50
- 性別
- 男
- 來自
- 台灣
- 註冊時間
- 2020-7-15
- 最後登錄
- 2024-10-21
|
回復 8# 准提部林
謝謝論壇,謝謝前輩
後學藉此帖學習前輩的方案,方案學習心得註解如下,請前輩再指導
執行前:
執行結果:
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 |
|
發表於 2023-6-9 09:02
| 