- 帖子
- 1446
- 主題
- 40
- 精華
- 0
- 積分
- 1470
- 點名
- 0
- 作業系統
- Windows 7
- 軟體版本
- Excel 2010 & 2016
- 閱讀權限
- 50
- 性別
- 男
- 來自
- 台灣
- 註冊時間
- 2020-7-15
- 最後登錄
- 2024-10-21
|
本帖最後由 Andy2483 於 2023-5-31 10:28 編輯
謝謝論壇,謝謝各位前輩
後學藉此帖練習VBA陣列與字典,學習方案如下,請各位前輩指教
執行結果:
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 |
|
發表於 2023-5-31 10:17
| 