Andy2483

謝謝論壇,謝謝各位前輩
後學藉此帖練習VBA陣列與字典,學習方案如下,請各位前輩指教

執行結果:

下載 (74.81 KB)

2023-5-31 10:16

Option Explicit
Sub TEST()
Dim Brr, Crr, Y, j%, T$, T1$, R%
'↑宣告變數
Set Y = CreateObject("Scripting.Dictionary")
'↑令Y變數是 字典
Brr = Range([B5], Cells(1, Columns.Count).End(1))
'↑令Brr變數是二維陣列,以1~5列資料帶入陣列中(不包含標題欄與空欄)
ReDim Crr(1 To UBound(Brr, 2), 1 To 2)
'↑令Crr變數是 二維空陣列,縱向同Brr橫向範圍,橫向1~2
For j = 1 To UBound(Brr, 2)
'↑設順迴圈
   T = Brr(4, j): T1 = Brr(2, j)
   '↑令T變數是 第4列陣列值,令T1變數是 第2列陣列值
   If Y(T) = "" Then R = R + 1: Y(T) = R: Crr(R, 1) = T: Crr(R, 2) = T1: GoTo j01
   '↑如果T變數是第1次納入Y字典,就令R變數累加1(紀錄列號),
   '令T變數在Y字典裡的item("")換成R變數,
   '令Crr陣列第1欄放 數量,令Crr陣列第2欄放 第1個箱號
   '跳到標示j01位置繼續執行
   Crr(Y(T), 2) = Crr(Y(T), 2) & "," & T1
   '↑程序會跑到這位置!都是第2次以上出現的key,
   '令Crr陣列第2欄繼續累積箱號,以逗號隔開
j01: Next
[I8:J8] = [{"數量","箱號"}]: [I9].Resize(R, 2) = Crr
'↑令儲存格第8列是標題列,令Crr陣列從[I9]開始寫入儲存格裡
Set Y = Nothing: Erase Brr, Crr
'↑令釋放變數
End Sub


'===================================================
'標題欄迴圈中處理的方案

Option Explicit
Sub TEST_1()
Dim Brr, Crr, Y, j%, T$, T1$, R%
Set Y = CreateObject("Scripting.Dictionary")
Brr = Range([A5], Cells(1, Columns.Count).End(1))
ReDim Crr(1 To UBound(Brr, 2), 1 To 2)
For j = 1 To UBound(Brr, 2)
   T = Brr(4, j): T1 = Brr(2, j)
   If Y(T) = "" Then R = R + 1: Y(T) = R: Crr(R, 1) = T: Crr(R, 2) = T1: GoTo j01
   Crr(Y(T), 2) = Crr(Y(T), 2) & "," & T1
j01: Next
[I8].Resize(R, 2) = Crr
Set Y = Nothing: Erase Brr, Crr
End Sub