萬筆資料快速比對處理 - Excel程式區

　暱稱: 厚臉皮的學生

帖子: 1446
主題: 40
精華: 0
積分: 1470
點名: 0
作業系統: Windows 7
軟體版本: Excel 2010 & 2016
閱讀權限: 50
性別: 男
來自: 台灣
註冊時間: 2020-7-15
最後登錄: 2024-10-21

12^#

發表於 2023-5-24 16:33 | 只看該作者

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

執行前:

執行結果:

Option Explicit
Sub TEST() '↑
Application.ScreenUpdating = False
Dim Brr, Y, R&, i&, T$, ST
ST = Timer
Set Y = CreateObject("Scripting.Dictionary")
Brr = Range([工作表2!B1], [工作表2!A65536].End(3))
For i = 1 To UBound(Brr): T = Brr(i, 1): Y(T) = 1: Next
Brr = Range([工作表1!B1], [工作表1!B65536].End(3))
For i = 1 To UBound(Brr): T = Brr(i, 1): Brr(i, 1) = Y(T): Y(T) = "": Next
[工作表1!I1].Resize(UBound(Brr), 1) = Brr
With Range([工作表1!I1], [工作表1!A65536].End(3))
.Sort KEY1:=.Item(9), Order1:=1, Header:=1, Orientation:=1
End With
R = [I1].End(xlDown).Row
Rows(R + 1 & ":65536").Clear
[I:I].Clear
Set Y = Nothing: Erase Brr
MsgBox Format(Timer - ST, "0.0秒")
End Sub

用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

　暱稱: 厚臉皮的學生

帖子: 1446
主題: 40
精華: 0
積分: 1470
點名: 0
作業系統: Windows 7
軟體版本: Excel 2010 & 2016
閱讀權限: 50
性別: 男
來自: 台灣
註冊時間: 2020-7-15
最後登錄: 2024-10-21

13^#

發表於 2023-5-25 11:40 | 只看該作者

謝謝論壇,謝謝各位前輩
後學藉此帖複習方案,方案複習心得註解如下,請各位前輩指教

Option Explicit
Sub TEST()
Application.ScreenUpdating = False
'↑令螢幕畫面不隨程序變化結果
Dim Brr, Y, R&, i&, T$, ST, S
'↑宣告變數
ST = Timer
'↑令ST變數是當下時間
Set Y = CreateObject("Scripting.Dictionary")
'↑令Y變數是字典
Brr = Range([工作表2!B1], [工作表2!A65536].End(3))
'↑令Brr變數是二維陣列,以表2的A~B欄儲存格值帶入陣列中
For i = 1 To UBound(Brr): T = Brr(i, 1): Y(T) = 1: Next
'↑設順迴圈!令以股票代號當key,item是1,納入Y字典中
Brr = Range([工作表1!B1], [工作表1!B65536].End(3))
'↑令Brr陣列換裝表1的B欄儲存格值
For i = 1 To UBound(Brr): T = Brr(i, 1): Brr(i, 1) = Y(T): Y(T) = "": Next
'↑設順迴圈!將Brr回迴圈陣列值換成查Y字典得到的item值,
'並讓重複key查Y字典的item值變成空字元,只留一筆值是1
[工作表1!I1].Resize(UBound(Brr), 1) = Brr
'↑令表1的I欄當輔助欄,令Brr陣列值寫入I欄中
With Range([工作表1!I1], [工作表1!A65536].End(3))
.Sort KEY1:=.Item(9), Order1:=1, Header:=1, Orientation:=1
End With
'↑令以I欄為排序基準,做有標題列的縱向順排序
R = [I1].End(xlDown).Row
'↑令R變數是排序後 I欄最後一個有內容的儲存格列號
Rows(R + 1 & ":65536").Clear
'↑令I欄是空格的列通通清除
'因為有排序的關係,I欄是空格的列被擠到後方了
[I:I].Clear
'↑令這I欄(輔助欄)功成身退!做清除
Set Y = Nothing: Erase Brr
'↑令釋放變數
S = Format(Timer - ST, "0.0秒")
MsgBox Format(Timer - ST, "0.0秒")
'↑令跳出提示窗,顯示此當下時間-ST變數後轉化為有1位小數的"?.?秒"字串
End Sub

用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

　暱稱: 厚臉皮的學生

帖子: 1446
主題: 40
精華: 0
積分: 1470
點名: 0
作業系統: Windows 7
軟體版本: Excel 2010 & 2016
閱讀權限: 50
性別: 男
來自: 台灣
註冊時間: 2020-7-15
最後登錄: 2024-10-21

14^#

發表於 2023-5-25 14:20 | 只看該作者

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

Option Explicit
Sub TEST_2()
Dim Arr, Brr, Crr, Y, R&, i&, j&, ST
'↑宣告變數
ST = Timer
'↑令ST變數是當下時間
Set Y = CreateObject("Scripting.Dictionary")
'↑令Y變數是字典
Brr = Range([工作表2!A1], [工作表2!A65536].End(3))
'↑令Brr變數是二維陣列,以表2的A欄儲存格值帶入陣列中
For i = 1 To UBound(Brr): Y(Brr(i, 1) & "") = i: Next
'↑設順迴圈!令以股票代號當key,item是i迴圈數(列號),納入Y字典中
Arr = Range([工作表1!H1], [工作表1!A65536].End(3))
'↑令Arr變數是二維陣列,以表1的A~H欄儲存格值帶入陣列中
ReDim Crr(1 To UBound(Arr), 1 To 8)
'↑宣告Crr變數是二維空陣列,縱向範圍同Arr陣列,橫向1~8
For i = 1 To UBound(Arr)
'↑設順迴圈!
If Y(Arr(i, 2) & "") = "" Then GoTo i01
'↑如果以股票代號查Y字典得item值是空的!就跳到i01標示位置繼續執行
R = R + 1
'↑令R變數累加1 (結果值放置的列號)
For j = 1 To 8: Crr(R, j) = Arr(i, j): Next
'↑設順迴圈!將Arr陣列值謄到Crr陣列裡
Y(Arr(i, 2) & "") = ""
'↑令以股票代號的key對應的item改為空的
i01: Next
With Sheets("工作表1")
.UsedRange.Clear
'↑令清除舊資料
.[A1].Resize(R, 8) = Crr
'↑令Crr陣列值寫入儲存格裡
End With
Set Y = Nothing: Erase Arr, Brr, Crr
'↑令釋放變數
MsgBox Format(Timer - ST, "0.0秒")
'↑令跳出提示窗,顯示此當下時間-ST變數後轉化為有1位小數的"?.?秒"字串
End Sub

用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

　暱稱: 厚臉皮的學生

帖子: 1446
主題: 40
精華: 0
積分: 1470
點名: 0
作業系統: Windows 7
軟體版本: Excel 2010 & 2016
閱讀權限: 50
性別: 男
來自: 台灣
註冊時間: 2020-7-15
最後登錄: 2024-10-21

15^#

發表於 2023-5-25 14:37 | 只看該作者

本帖最後由 Andy2483 於 2023-5-25 14:57 編輯

謝謝論壇,謝謝各位前輩
後學藉此帖練習陣列與字典,學習將上一帖3個陣列減為2個陣列,學習方案如下,請各位前輩指教

Option Explicit
Sub TEST_3()
Dim Arr, Brr, Y, R&, i&, j&, ST
'↑宣告變數
ST = Timer
'↑令ST變數是當下時間
Set Y = CreateObject("Scripting.Dictionary")
'↑令Y變數是字典
Brr = Range([工作表2!A1], [工作表2!A65536].End(3))
'↑令Brr變數是二維陣列,以表2的A欄儲存格值帶入陣列中
For i = 1 To UBound(Brr): Y(Brr(i, 1) & "") = i: Next
'↑設順迴圈!令以股票代號當key,item是i迴圈數(列號),納入Y字典中
Arr = Range([工作表1!H1], [工作表1!A65536].End(3))
'↑令Arr變數是二維陣列,以表1的A~H欄儲存格值帶入陣列中
For i = 1 To UBound(Arr)
'↑設順迴圈!
If Y(Arr(i, 2) & "") = "" Then GoTo i01
'↑如果以股票代號查Y字典得item值是空的!就跳到i01標示位置繼續執行
R = R + 1
'↑令R變數累加1 (結果值放置的列號)
For j = 1 To 8: Arr(R, j) = Arr(i, j): Next
'↑設順迴圈!將Arr陣列值往上謄,覆蓋掉原陣列值
Y(Arr(i, 2) & "") = ""
'↑令以股票代號的key對應的item改為空的
i01: Next
With Sheets("工作表1")
.UsedRange.Clear
'↑令清除舊資料
.[A1].Resize(R, 8) = Arr
'↑令Arr陣列值寫入儲存格裡,超過這儲存格範圍的陣列值忽略
End With
Set Y = Nothing: Erase Arr, Brr
'↑令釋放變數
MsgBox Format(Timer - ST, "0.0秒")
'↑令跳出提示窗,顯示此當下時間-ST變數後轉化為有1位小數的"?.?秒"字串
End Sub

==============================================================
以下是學習將上一Code 將2個陣列減為1個陣列,學習方案如下

Option Explicit
Sub TEST_4()
Dim Brr, Y, R&, i&, j&, ST
'↑宣告變數
ST = Timer
'↑令ST變數是當下時間
Set Y = CreateObject("Scripting.Dictionary")
'↑令Y變數是字典
Brr = Range([工作表2!A1], [工作表2!A65536].End(3))
'↑令Brr變數是二維陣列,以表2的A欄儲存格值帶入陣列中
For i = 1 To UBound(Brr): Y(Brr(i, 1) & "") = i: Next
'↑設順迴圈!令以股票代號當key,item是i迴圈數(列號),納入Y字典中
Brr = Range([工作表1!H1], [工作表1!A65536].End(3))
'↑令Brr陣列換裝表1的A~H欄儲存格值
For i = 1 To UBound(Brr)
'↑設順迴圈!
If Y(Brr(i, 2) & "") = "" Then GoTo i01
'↑如果以股票代號查Y字典得item值是空的!就跳到i01標示位置繼續執行
R = R + 1
'↑令R變數累加1 (結果值放置的列號)
For j = 1 To 8: Brr(R, j) = Brr(i, j): Next
'↑設順迴圈!將Brr陣列值往上謄,覆蓋掉原陣列值
Y(Brr(i, 2) & "") = ""
'↑令以股票代號的key對應的item改為空的
i01: Next
With Sheets("工作表1")
.UsedRange.Clear
'↑令清除舊資料
.[A1].Resize(R, 8) = Brr
'↑令Brr陣列值寫入儲存格裡,超過這儲存格範圍的陣列值忽略
End With
Set Y = Nothing: Erase Brr
'↑令釋放變數
MsgBox Format(Timer - ST, "0.0秒")
'↑令跳出提示窗,顯示此當下時間-ST變數後轉化為有1位小數的"?.?秒"字串
End Sub

用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流