[發問] 萬筆資料快速比對處理

　暱稱: 厚臉皮的學生

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

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

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

　暱稱: 厚臉皮的學生

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

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

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

　暱稱: 厚臉皮的學生

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

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

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

　暱稱: 厚臉皮的學生

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

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

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

bioleon69

　暱稱: 小B

中學生 Rank: 2

帖子: 62
主題: 14
精華: 0
積分: 86
點名: 0
作業系統: win10
軟體版本: offffice2013
閱讀權限: 20
性別: 男
來自: 台北
註冊時間: 2016-8-23
最後登錄: 2017-11-5

論壇贊助勳章

11^#

發表於 2017-10-13 20:05 | 只看該作者

回復 10# mhl9mhl9

TO
mhl9mhl9

謝謝大大解說程式碼的邏輯順序
我再好好研究看看!
謝謝!!以後請多多指教!!

VBA 從0開始
先從學會看的懂開始
先從會有基本修改能力開始
一步一步學習中

mhl9mhl9

中學生 Rank: 2

帖子: 214
主題: 74
精華: 0
積分: 296
點名: 0
作業系統: win7
軟體版本: office2007
閱讀權限: 20
性別: 男
來自: hk
註冊時間: 2013-6-17
最後登錄: 2018-11-3

10^#

發表於 2017-10-13 17:54 | 只看該作者

回復 1# bioleon69
sheet1的20000筆資料裝進d,sheet2的500筆資料裝進dd,凡是d里有dd的編號的資料裝進ddd,最後刪除sheet1的舊資料貼上ddd,就是所需結果.
由於字典執行得很快,上述邏輯清楚,如果資料源有變化或結果要求有變化,程式碼很容易修改.所以類似課題我都喜歡用字典處理.

lmh

bioleon69

　暱稱: 小B

中學生 Rank: 2

帖子: 62
主題: 14
精華: 0
積分: 86
點名: 0
作業系統: win10
軟體版本: offffice2013
閱讀權限: 20
性別: 男
來自: 台北
註冊時間: 2016-8-23
最後登錄: 2017-11-5

論壇贊助勳章

9^#

發表於 2017-10-11 21:19 | 只看該作者

本帖最後由 bioleon69 於 2017-10-11 21:21 編輯

回復 8# Hsieh

謝謝
ziv976688
Kubi
mhl9mhl9
Hsieh
的指導方法

ziv976688
謝謝您的指導,我了解意思了
因為我主要是想把工作表1的數據留下需要看得而已
兩萬筆占了太多容量..
目前是在加迴圈判斷把NA的全部刪除後
工作表2資料複製起來
再跳到工作表1,把兩萬筆刪除
然後再將比對後的VALUE值貼到工作表1
這是目前小弟的照著您的說明演變的解決方法感謝感謝

KUBI
感謝提醒,我知道原因是什麼了哈
工作表2的數據一個月才會公布一次
工作表1的是每周,中間隔了三周沒更新
資料有異動

mhl9mhl9
感謝您的指導
不過小弟的程度似乎還不太夠
再慢慢吸收中...
哈程式碼稍微高深了點拉!!
不過這個字典的功能速度倒是挺快!!
(PS,不是作業拉!..小弟自己每周追蹤股票用的..自用..自用)

Hsieh
感謝版大...這動態圖片真夠牛B
目前照著錄製後(程式碼只有兩行!)
自行錄製後>刪除工作表1的2萬筆資料
再將進階篩選後的資料貼到工作表1

目前兩個比對方法入手感謝感謝各位大大!!

VBA 從0開始
先從學會看的懂開始
先從會有基本修改能力開始
一步一步學習中