Andy2483

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

資料表:

下載 (113.75 KB)

2023-5-16 14:01

結果表執行前:

下載 (120.89 KB)

2023-5-16 14:02

執行結果:

下載 (131.05 KB)

2023-5-16 14:02

Option Explicit
Sub TEST()
Dim Arr, Brr, Crr, Y, i&, j&, Q&
'↑宣告變數
Set Y = CreateObject("Scripting.Dictionary")
'↑令Y變數是 字典
With 工作表1: Arr = Range(.[L6], .[B65536].End(3)): End With
'↑令Arr變數是 二維陣列,以儲存格值帶入陣列中
For i = 1 To UBound(Arr):  Y(Arr(i, 1)) = i: Next
'↑令Arr陣列的迴圈列第1欄值當key,item是i迴圈變數(以字典紀錄鍵值與列號)
With 工作表2
   .[F7].Resize(1000, 10).ClearContents
   '↑令結果表清除儲存格舊結果
   Brr = Range(.[E7], .[E65536].End(3))
   '↑令Arr變數是 二維陣列,以儲存格值帶入陣列中
End With
ReDim Crr(1 To UBound(Brr), 1 To 10)
'↑令宣告Crr變數是 二維空陣列,縱向範圍同Brr,橫向範圍索引號1~10
For i = 1 To UBound(Brr)
'↑設順迴圈
   Q = Y(Brr(i, 1))
   '↑令Q變數帶出Brr陣列1欄關鍵字在Y字典裡紀錄的Arr陣列列號
   If Q = 0 Then Crr(i, 1) = "查無此PN": GoTo i01
   '↑如果Q變數是 0,代表Arr陣列裡無此鍵,只在註記欄位做註記
   For j = 1 To 10: Crr(i, j) = Arr(Q, j + 1): Next
   '↑設迴圈將Arr陣列值帶入Crr陣列
i01: Next
[工作表2!F7].Resize(UBound(Crr), 10) = Crr
'↑令Crr陣列值從[工作表2!F7]開始,倒入儲存格中
Set Y = Nothing: Erase Arr, Brr, Crr
'↑令釋放變數
End Sub