Andy2483

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

List資料庫:

下載 (20.16 KB)

2023-5-25 16:15

資料表(新比對資料):

下載 (17.81 KB)

2023-5-25 16:17

結果表執行前:

下載 (20.44 KB)

2023-5-25 16:17

執行結果:

下載 (22.61 KB)

2023-5-25 16:18

Option Explicit
Sub TEST()
Dim Brr, Y, R&, i&, j&, T$
'↑宣告變數
Set Y = CreateObject("Scripting.Dictionary")
'↑令Y變數是字典
Brr = Range([List!C1], [List!A65536].End(xlUp))
'↑令Brr變數是 二維陣列,以List表A~C欄儲存格值帶入陣列裡
For i = 2 To UBound(Brr)
'↑設順迴圈
   T = Brr(i, 1) & Brr(i, 2) & Brr(i, 3): Y(T) = i
   '↑令以每個迴圈3欄值組成的新字串當key,item是列號,納入Y字典
Next
Brr = Range([資料!C1], [資料!A65536].End(xlUp))
'↑令Br陣列,換裝資料表A~C欄儲存格值
For i = 2 To UBound(Brr)
'↑設順迴圈
   T = Brr(i, 1) & Brr(i, 2) & Brr(i, 3)
   If Y(T) <> "" Then GoTo i01
   '↑如果以迴圈3欄值組成的新字串查Y字典得item值不是空的,
   '就跳到標示i01位置繼續執行
   R = R + 1
   '↑令R變數累加1
   For j = 1 To 3: Brr(R, j) = Brr(i, j): Next
   '↑設順迴圈!將Brr陣列值往上謄,將原陣列值覆蓋
i01: Next
If R = 0 Then MsgBox "無新增": GoTo i02
'↑如果R變數是初始值0,就跳到標示i02位置繼續執行
With Sheets("此次新增")
   .UsedRange.Offset(1, 0).Clear
   '↑將結果表有使用儲存格往下偏移1列的範圍清除
   .[A2].Resize(R, 3) = Brr
   '↑令Brr陣列值寫入結果表中,超出範圍的陣列值忽略
End With
i02: Set Y = Nothing: Erase Brr
'↑令釋放變數
End Sub

=============================================
補充: 以下是將結果資料謄入另一陣列的方法

Option Explicit
Sub TEST_1()
Dim Brr, Crr, Y, R&, i&, j&, T$
'↑宣告變數
Set Y = CreateObject("Scripting.Dictionary")
'↑令Y變數是字典
Brr = Range([List!C1], [List!A65536].End(xlUp))
'↑令Brr變數是 二維陣列,以List表A~C欄儲存格值帶入陣列裡
For i = 2 To UBound(Brr)
'↑設順迴圈
   T = Brr(i, 1) & Brr(i, 2) & Brr(i, 3): Y(T) = i
   '↑令以每個迴圈3欄值組成的新字串當key,item是列號,納入Y字典
Next
Brr = Range([資料!C1], [資料!A65536].End(xlUp))
'↑令Br陣列,換裝資料表A~C欄儲存格值
ReDim Crr(1 To UBound(Brr), 1 To 3)
'↑宣告Crr變數是 二維空陣列,縱向範圍同Brr,橫向1~3
For i = 2 To UBound(Brr)
'↑設順迴圈
   T = Brr(i, 1) & Brr(i, 2) & Brr(i, 3)
   If Y(T) <> "" Then GoTo i01
   '↑如果以迴圈3欄值組成的新字串查Y字典得item值不是空的,
   '就跳到標示i01位置繼續執行
   R = R + 1
   '↑令R變數累加1
   For j = 1 To 3: Crr(R, j) = Brr(i, j): Next
   '↑設順迴圈!將Brr陣列值寫入Crr陣列中
i01: Next
If R = 0 Then MsgBox "無新增": GoTo i02
'↑如果R變數是初始值0,就跳到標示i02位置繼續執行
With Sheets("此次新增")
   .UsedRange.Offset(1, 0).Clear
   '↑將結果表有使用儲存格往下偏移1列的範圍清除
   .[A2].Resize(R, 3) = Crr
   '↑令Crr陣列值寫入結果表中,超出範圍的陣列值忽略
End With
i02: Set Y = Nothing: Erase Brr, Crr
'↑令釋放變數
End Sub