Sub update()
Dim Arr, xD, T$, i&, U&, S, N&
[sheet1!A:B].ClearContents
Arr = Range([data!B1], [data!A65536].End(xlUp))
Set xD = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(Arr)
T = Arr(i, 1): If T = "" Then GoTo 101
U = xD(T): S = Val(Arr(i, 2))
If U = 0 Then
N = N + 1: U = N: xD(T) = N
Arr(U + 1, 1) = T: Arr(U + 1, 2) = 0
End If
Arr(U + 1, 2) = Arr(U + 1, 2) + S
101: Next
If N = 0 Then Exit Sub
With [sheet1!A1:B1].Resize(N + 1)
.Columns(1).NumberFormatLocal = "@"
.Value = Arr
End With
End Sub
Sub update()
Dim Arr, xD, T$, i&, U&, S, N&
'↑宣告變數
[sheet1!A:B].ClearContents
'↑令結果表A~B欄清除內容
Arr = Range([data!B1], [data!A65536].End(xlUp))
'↑令Arr變數是 二維陣列,以date表A~B欄資料帶入陣列中
Set xD = CreateObject("Scripting.Dictionary")
'↑令xD變數是 字典
For i = 2 To UBound(Arr)
'↑設順迴圈
T = Arr(i, 1): If T = "" Then GoTo 101
'↑令T變數是陣列第1欄字串值;如果T變數是空字元,就跳到101位置繼續執行
U = xD(T): S = Val(Arr(i, 2))
'↑令U變數是 以T變數查xD字典回傳item,令S變數是 陣列第2欄值轉數值
If U = 0 Then
'↑如果U變數是0?
N = N + 1: U = N: xD(T) = N
'↑令N變數累加1(累計結果資料最後列號),令U變數是N變數值,
'令T變數當key,item是N變數(令字典幫記住結果料件代號在哪一列的下一列?)
Arr(U + 1, 1) = T: Arr(U + 1, 2) = 0
'↑令U+1列第1欄Arr陣列值是 T變數(料件代號)
'↑令U+1列第2欄Arr陣列值是 0 (因為用同一陣列寫入結果資料!先歸零)
'(U+1是為了保留標題列)
End If
Arr(U + 1, 2) = Arr(U + 1, 2) + S
'↑令U+1列第2欄Arr陣列值累加 S變數(應發數量)
101: Next
If N = 0 Then Exit Sub
'↑如果N變數(沒有重複的 料件代號),就結束程式執行
With [sheet1!A1:B1].Resize(N + 1)
'↑以下是表1從[A1:B1]開始向下擴展(N+1)列的儲存格範圍,關於這範圍程序
.Columns(1).NumberFormatLocal = "@"
'↑令這範圍的第1欄儲存格格式是文字
.Value = Arr
'↑令這範圍儲存格值是Arr陣列值,超過這範圍的陣列值忽略
End With
End Sub作者: Andy2483 時間: 2023-6-2 08:56
本帖最後由 Andy2483 於 2023-6-2 08:58 編輯
謝謝論壇,謝謝各位前輩
後學藉此帖練習陣列與字典,學習方案使用2個陣列方案如下,請各位前輩指教
Option Explicit
Sub TEST()
Dim Brr, Crr, Y, R&, i&, T1$, T2$, K&
Dim xRd As Range, Shd As Worksheet, Sha As Worksheet
'↑宣告變數
Set Y = CreateObject("Scripting.Dictionary")
'↑令Y變數是 字典
Set Shd = Sheets("data"): Set Sha = Sheets("sheet1"): Sha.[A:B].ClearContents
'↑令變數裝入物件(工作表),令結果表清除舊資料
Set xRd = Range(Shd.[B1], Shd.Cells(Rows.Count, 1).End(xlUp))
'↑令xRd變數裝入物件(資料表A~B欄儲存格)
Brr = xRd: K = UBound(Brr): ReDim Crr(1 To K, 1 To 2)
'↑令Brr變數是 二維陣列,以xRd變數值帶入陣列中,
'令K變數是Brr陣列縱向最大索引列號,
'令Crr變數是 二維空陣列,宣告他的範圍縱向同Brr陣列,橫向1~2索引號
For i = 1 To K
'↑設順迴圈
T1 = Brr(i, 1): T2 = Brr(i, 2)
'↑令變數裝入陣列值,成為字串變數
If i = 1 Then R = R + 1: Crr(i, 1) = T1: Crr(i, 2) = T2: GoTo i01
'↑如果i迴圈是 1!就令R是0+1,令Crr陣列標題列同Brr陣列,令跳到i01位置繼續執行
If Y(T1) = "" Then R = R + 1: Y(T1) = R: Crr(R, 1) = T1
'↑如果以T1變數查Y字典回傳item是空字元(初次納入字典),就令R變數+1(累計列號)
'令在Y字典中key是 T1變數的item換成是 R變數(記住 料件代號是放在Crr哪一列)
'令Crr陣列寫入該 料件代號
Crr(Y(T1), 2) = Crr(Y(T1), 2) + Val(T2)
'↑令Crr陣列第2欄累加 應發數量
i01: Next
Sha.[A:A].NumberFormatLocal = "@"
'↑令結果表A欄儲存格格式是文字
Sha.[A1].Resize(R, 2) = Crr
'↑令結果表[A1]擴展範圍帶入Crr陣列值,超過此範圍的Crr陣列值忽略
Set Y = Nothing: Set xRd = Nothing: Set Shd = Nothing
Set Sha = Nothing: Erase Brr, Crr
'↑令釋放變數
End Sub
