萬筆資料快速比對處理
[i=s] 本帖最後由 bioleon69 於 2017-10-9 23:11 編輯 [/i]工作表一
約有兩萬筆資料
[attach]27793[/attach]
工作表二
約有250筆資料
[attach]27794[/attach]
想從工作表一只留下與工作表2符合的股票代號
不符合的rows全部刪除掉
最後留下的資料會只剩下跟工作表2一樣(約250筆)
而不是兩萬筆資料...
請問大大們
這樣情況
應該得怎麼處理會比較快速
還請各位大大指導技巧
謝謝!
[color=Red][b]祝各位中秋愉快![/b][/color]
附上 excel檔
[attach]27795[/attach] [i=s] 本帖最後由 ziv976688 於 2017-10-10 02:59 編輯 [/i]
[b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=100787&ptid=20180]1#[/url] [i]bioleon69[/i] [/b]
[attach]27796[/attach]
Sheet1!B1
=IF($A1="","",VLOOKUP($A1,Sheet1!$B:$H,COLUMN(),))
右拉至G欄，在右下角的小"+"快速點2次，或下拉填滿。
Sheet2!B:G有很多顯示#N/A的儲存格，
Sheet2! A欄的某些代號，是不是Sheet1!B欄沒有？
Sheet1!太多筆，沒仔細看。 [b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=100787&ptid=20180]1#[/url] [i]bioleon69[/i] [/b]
[attach]27797[/attach]
不好意思，沒注意到問題是放在程式區
再補上程式碼
Private Sub CommandButton1_Click()
[B1:G500] = ""
[B1].Resize(500, 6) = "=IF($A1="""","""",VLOOKUP($A1,Sheet1!$B:$H,COLUMN(),))"
[B1].Resize(500, 6) = [B1].Resize(500, 6).Value
[H1].Select
End Sub [b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=100789&ptid=20180]3#[/url] [i]ziv976688[/i] [/b]
ZIV~謝謝你的回覆!
如果是說
要把SHEET1多餘的不符合股票代號
全部刪除應該怎麼做比較好?! [i=s] 本帖最後由 ziv976688 於 2017-10-10 19:11 編輯 [/i]
[b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=100793&ptid=20180]4#[/url] [i]bioleon69[/i] [/b]
Sheet1=資料庫，Sheet2要比對的A欄資料一般都應該是以手動方式填入的，因此，是不是先將Sheet2!A不要比對的列，先自行移除後再執行巨集。
或在第一次執行巨集後，將Sheet2有顯示#N/A的列移除(筆數不多，且只要移除一次，應該不會很麻煩)，再執行巨集一次即可。
我不懂股票，不知其代號有沒有特定的型態?有的話，可以用"取代"或程式移除非指定型態的Sheet1的列
以上僅供參考 [b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=100787&ptid=20180]1#[/url] [i]bioleon69[/i] [/b]
依你篩選規則，從1萬9千多筆資料中總共會篩出272筆資料，與需比對的249筆資料多出23筆，經檢查資料庫後發現共有33筆股票代號會有兩種股票名稱，例如：
61071包含：微星國票71購01、華美一，兩種股票名稱
61262包含：榮成元大6C購01、信音二，兩種股票名稱
61274包含：興勤永豐6C購01、九豪四，兩種股票名稱
...族繁不及備載。
另外需比對的249筆資料中，沒被篩出的股票代號共有底下的10筆：
13361、14663、17152、24022、30181、30392、35352、47143、80381、81712 [attach]27798[/attach]
sheets(1)的按鈕可以完成你的作業 [b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=100787&ptid=20180]1#[/url] [i]bioleon69[/i] [/b]
進階篩選
[attach]27800[/attach] [i=s] 本帖最後由 bioleon69 於 2017-10-11 21:21 編輯 [/i]
[b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=100807&ptid=20180]8#[/url] [i]Hsieh[/i] [/b]
謝謝
ziv976688
Kubi
mhl9mhl9
Hsieh
的指導方法
[b]ziv976688[/b]
謝謝您的指導,我了解意思了
因為我主要是想把工作表1的數據留下需要看得而已
兩萬筆占了太多容量..
目前是在加迴圈判斷把NA的全部刪除後
工作表2資料複製起來
再跳到工作表1,把兩萬筆刪除
然後再將比對後的VALUE值貼到工作表1
這是目前小弟的照著您的說明演變的解決方法 感謝感謝
[b]KUBI [/b]
感謝提醒,我知道原因是什麼了 哈
工作表2的數據一個月才會公布一次
工作表1的是每周,中間隔了三周沒更新
資料有異動
[b]mhl9mhl9[/b]
感謝您的指導
不過小弟的程度似乎還不太夠
再慢慢吸收中...
哈 程式碼稍微高深了點拉!!
不過這個字典的功能速度倒是挺快!!
(PS,不是作業拉!..小弟自己每周追蹤股票用的..自用..自用)
[b]Hsieh[/b]
感謝版大...這動態圖片真夠牛B
目前照著錄製後(程式碼只有兩行!)
自行錄製後>刪除工作表1的2萬筆資料
再將進階篩選後的資料貼到工作表1
目前兩個比對方法入手 感謝感謝各位大大!! [b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=100787&ptid=20180]1#[/url] [i]bioleon69[/i] [/b]
sheet1的20000筆資料裝進d,sheet2的500筆資料裝進dd,凡是d里有dd的編號的資料裝進ddd,最後刪除sheet1的舊資料貼上ddd,就是所需結果.
由於字典執行得很快,上述邏輯清楚,如果資料源有變化或結果要求有變化,程式碼很容易修改.所以類似課題我都喜歡用字典處理. [b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=100818&ptid=20180]10#[/url] [i]mhl9mhl9[/i] [/b]
TO
mhl9mhl9
謝謝大大解說程式碼的邏輯順序
我再好好研究看看!
謝謝!!以後請多多指教!! 謝謝論壇,謝謝各位前輩
後學藉此帖練習陣列與字典,學習方案如下,請各位前輩指教
執行前:
[attach]36425[/attach]
執行結果:
[attach]36426[/attach]
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 謝謝論壇,謝謝各位前輩
後學藉此帖複習方案,方案複習心得註解如下,請各位前輩指教
Option Explicit
Sub TEST()
Application.ScreenUpdating = False
[color=SeaGreen]'↑令螢幕畫面不隨程序變化結果[/color]
Dim Brr, Y, R&, i&, T$, ST, S
[color=SeaGreen]'↑宣告變數[/color]
ST = Timer
[color=SeaGreen]'↑令ST變數是 當下時間[/color]
Set Y = CreateObject("Scripting.Dictionary")
[color=SeaGreen]'↑令Y變數是 字典[/color]
Brr = Range([工作表2!B1], [工作表2!A65536].End(3))
[color=SeaGreen]'↑令Brr變數是 二維陣列,以表2的A~B欄儲存格值帶入陣列中[/color]
For i = 1 To UBound(Brr): T = Brr(i, 1): Y(T) = 1: Next
[color=SeaGreen]'↑設順迴圈!令以股票代號當key,item是1,納入Y字典中[/color]
Brr = Range([工作表1!B1], [工作表1!B65536].End(3))
[color=SeaGreen]'↑令Brr陣列換裝表1的B欄儲存格值[/color]
For i = 1 To UBound(Brr): T = Brr(i, 1): Brr(i, 1) = Y(T): Y(T) = "": Next
[color=SeaGreen]'↑設順迴圈!將Brr回迴圈陣列值換成查Y字典得到的item值,
'並讓重複key查Y字典的item值變成 空字元,只留一筆值是1[/color]
[工作表1!I1].Resize(UBound(Brr), 1) = Brr
[color=SeaGreen]'↑令表1的I欄當輔助欄,令Brr陣列值寫入I欄中[/color]
With Range([工作表1!I1], [工作表1!A65536].End(3))
.Sort KEY1:=.Item(9), Order1:=1, Header:=1, Orientation:=1
End With
[color=SeaGreen]'↑令以I欄為排序基準,做有標題列的縱向順排序[/color]
R = [I1].End(xlDown).Row
[color=SeaGreen]'↑令R變數是排序後 I欄最後一個有內容的儲存格列號[/color]
Rows(R + 1 & ":65536").Clear
[color=SeaGreen]'↑令I欄是空格的列通通清除[/color]
[color=SeaGreen]'因為有排序的關係,I欄是空格的列被擠到後方了[/color]
[I:I].Clear
[color=SeaGreen]'↑令這I欄(輔助欄)功成身退!做清除[/color]
Set Y = Nothing: Erase Brr
[color=SeaGreen]'↑令釋放變數[/color]
S = Format(Timer - ST, "0.0秒")
MsgBox Format(Timer - ST, "0.0秒")
[color=SeaGreen]'↑令跳出提示窗,顯示此當下時間-ST變數後轉化為有1位小數的"?.?秒"字串[/color]
End Sub 謝謝論壇,謝謝前輩
後學藉此帖練習陣列與字典,學習方案如下,請各位前輩指教
Option Explicit
Sub TEST_2()
Dim Arr, Brr, Crr, Y, R&, i&, j&, ST
[color=SeaGreen]'↑宣告變數[/color]
ST = Timer
[color=SeaGreen]'↑令ST變數是 當下時間[/color]
Set Y = CreateObject("Scripting.Dictionary")
[color=SeaGreen]'↑令Y變數是 字典[/color]
Brr = Range([工作表2!A1], [工作表2!A65536].End(3))
[color=SeaGreen]'↑令Brr變數是 二維陣列,以表2的A欄儲存格值帶入陣列中[/color]
For i = 1 To UBound(Brr): Y(Brr(i, 1) & "") = i: Next
[color=SeaGreen]'↑設順迴圈!令以股票代號當key,item是i迴圈數(列號),納入Y字典中[/color]
Arr = Range([工作表1!H1], [工作表1!A65536].End(3))
[color=SeaGreen]'↑令Arr變數是 二維陣列,以表1的A~H欄儲存格值帶入陣列中[/color]
ReDim Crr(1 To UBound(Arr), 1 To 8)
[color=SeaGreen]'↑宣告Crr變數是 二維空陣列,縱向範圍同Arr陣列,橫向1~8[/color]
For i = 1 To UBound(Arr)
[color=SeaGreen]'↑設順迴圈![/color]
If Y(Arr(i, 2) & "") = "" Then GoTo i01
[color=SeaGreen] '↑如果以股票代號查Y字典得item值是空的!就跳到i01標示位置繼續執行[/color]
R = R + 1
[color=SeaGreen] '↑令R變數累加1 (結果值放置的列號)[/color]
For j = 1 To 8: Crr(R, j) = Arr(i, j): Next
[color=SeaGreen] '↑設順迴圈!將Arr陣列值謄到Crr陣列裡[/color]
Y(Arr(i, 2) & "") = ""
[color=SeaGreen] '↑令以股票代號的key對應的item改為空的[/color]
i01: Next
With Sheets("工作表1")
.UsedRange.Clear
[color=SeaGreen] '↑令清除舊資料[/color]
.[A1].Resize(R, 8) = Crr
[color=SeaGreen] '↑令Crr陣列值寫入儲存格裡[/color]
End With
Set Y = Nothing: Erase Arr, Brr, Crr
[color=SeaGreen]'↑令釋放變數[/color]
MsgBox Format(Timer - ST, "0.0秒")
[color=SeaGreen]'↑令跳出提示窗,顯示此當下時間-ST變數後轉化為有1位小數的"?.?秒"字串[/color]
End Sub [i=s] 本帖最後由 Andy2483 於 2023-5-25 14:57 編輯 [/i]
謝謝論壇,謝謝各位前輩
後學藉此帖練習陣列與字典,學習將上一帖3個陣列減為2個陣列,學習方案如下,請各位前輩指教
Option Explicit
Sub TEST_3()
Dim Arr, Brr, Y, R&, i&, j&, ST
[color=SeaGreen]'↑宣告變數[/color]
ST = Timer
[color=SeaGreen]'↑令ST變數是 當下時間[/color]
Set Y = CreateObject("Scripting.Dictionary")
[color=SeaGreen]'↑令Y變數是 字典[/color]
Brr = Range([工作表2!A1], [工作表2!A65536].End(3))
[color=SeaGreen]'↑令Brr變數是 二維陣列,以表2的A欄儲存格值帶入陣列中[/color]
For i = 1 To UBound(Brr): Y(Brr(i, 1) & "") = i: Next
[color=SeaGreen]'↑設順迴圈!令以股票代號當key,item是i迴圈數(列號),納入Y字典中[/color]
Arr = Range([工作表1!H1], [工作表1!A65536].End(3))
[color=SeaGreen]'↑令Arr變數是 二維陣列,以表1的A~H欄儲存格值帶入陣列中[/color]
For i = 1 To UBound(Arr)
[color=SeaGreen]'↑設順迴圈![/color]
If Y(Arr(i, 2) & "") = "" Then GoTo i01
[color=SeaGreen] '↑如果以股票代號查Y字典得item值是空的!就跳到i01標示位置繼續執行[/color]
R = R + 1
[color=SeaGreen] '↑令R變數累加1 (結果值放置的列號)[/color]
For j = 1 To 8: Arr(R, j) = Arr(i, j): Next
[color=SeaGreen] '↑設順迴圈!將Arr陣列值往上謄,覆蓋掉原陣列值[/color]
Y(Arr(i, 2) & "") = ""
[color=SeaGreen] '↑令以股票代號的key對應的item改為空的[/color]
i01: Next
With Sheets("工作表1")
.UsedRange.Clear
[color=SeaGreen] '↑令清除舊資料[/color]
.[A1].Resize(R, 8) = Arr
[color=SeaGreen] '↑令Arr陣列值寫入儲存格裡,超過這儲存格範圍的陣列值忽略[/color]
End With
Set Y = Nothing: Erase Arr, Brr
[color=SeaGreen]'↑令釋放變數[/color]
MsgBox Format(Timer - ST, "0.0秒")
[color=SeaGreen]'↑令跳出提示窗,顯示此當下時間-ST變數後轉化為有1位小數的"?.?秒"字串[/color]
End Sub
==============================================================
以下是學習將上一Code 將2個陣列減為1個陣列,學習方案如下
Option Explicit
Sub TEST_4()
Dim Brr, Y, R&, i&, j&, ST
[color=SeaGreen]'↑宣告變數[/color]
ST = Timer
[color=SeaGreen]'↑令ST變數是 當下時間[/color]
Set Y = CreateObject("Scripting.Dictionary")
[color=SeaGreen]'↑令Y變數是 字典[/color]
Brr = Range([工作表2!A1], [工作表2!A65536].End(3))
[color=SeaGreen]'↑令Brr變數是 二維陣列,以表2的A欄儲存格值帶入陣列中[/color]
For i = 1 To UBound(Brr): Y(Brr(i, 1) & "") = i: Next
[color=SeaGreen]'↑設順迴圈!令以股票代號當key,item是i迴圈數(列號),納入Y字典中[/color]
Brr = Range([工作表1!H1], [工作表1!A65536].End(3))
[color=SeaGreen]'↑令Brr陣列換裝表1的A~H欄儲存格值[/color]
For i = 1 To UBound(Brr)
[color=SeaGreen]'↑設順迴圈![/color]
If Y(Brr(i, 2) & "") = "" Then GoTo i01
[color=SeaGreen] '↑如果以股票代號查Y字典得item值是空的!就跳到i01標示位置繼續執行[/color]
R = R + 1
[color=SeaGreen] '↑令R變數累加1 (結果值放置的列號)[/color]
For j = 1 To 8: Brr(R, j) = Brr(i, j): Next
[color=SeaGreen] '↑設順迴圈!將Brr陣列值往上謄,覆蓋掉原陣列值[/color]
Y(Brr(i, 2) & "") = ""
[color=SeaGreen] '↑令以股票代號的key對應的item改為空的[/color]
i01: Next
With Sheets("工作表1")
.UsedRange.Clear
[color=SeaGreen] '↑令清除舊資料[/color]
.[A1].Resize(R, 8) = Brr
[color=SeaGreen] '↑令Brr陣列值寫入儲存格裡,超過這儲存格範圍的陣列值忽略[/color]
End With
Set Y = Nothing: Erase Brr
[color=SeaGreen]'↑令釋放變數[/color]
MsgBox Format(Timer - ST, "0.0秒")
[color=SeaGreen]'↑令跳出提示窗,顯示此當下時間-ST變數後轉化為有1位小數的"?.?秒"字串[/color]
End Sub
頁:
[1]