麻辣家族討論版版 » Excel程式區 » 最快速的比對資料方式?

PKKO 發表於 2015-9-4 16:31

最快速的比對資料方式?

[i=s] 本帖最後由 PKKO 於 2015-9-4 16:34 編輯 [/i]

小弟的比對資料以A欄位有兩萬筆資料然後比對B欄位的兩萬筆資料,作為範例資料

以前一直以為使用陣列做比對資料,一定是最快的,這是下方的程式碼[code]Sub test_B()
t1 = Hour(Now()) * 3600 + Minute(Now()) * 60 + Second(Now())

Rng = [a1].Resize(20000, 1).Value
rng2 = [b1].Resize(20000, 1).Value
For j = 1 To 20000
    For i = 1 To 10000
        If Rng(i, 1) = rng2(j, 1) Then
            '找到比對資料就跳開
            Exit For
        End If
    Next
Next
T2 = Hour(Now()) * 3600 + Minute(Now()) * 60 + Second(Now())
MsgBox "共耗時 " & T2 - t1 & " 秒"

End Sub[/code]後來才發現原來,下面的方式更快,但需要注意的重點是match的比對陣列,不可真的放置陣列,速度會比上方慢,且有65536列的限制,但使用範圍做比對,會比上方快450 %....[code]Sub test_A()
t1 = Hour(Now()) * 3600 + Minute(Now()) * 60 + Second(Now())

rng2 = [b1].Resize(20000, 1).Value
For i = 1 To 20000
    Application.Match(rng2(i, 1), Sheets("test").Range("A:A"), 0)
Next
T2 = Hour(Now()) * 3600 + Minute(Now()) * 60 + Second(Now())
MsgBox "共耗時 " & T2 - t1 & " 秒"
End Sub[/code][color=Red][size=6]小弟不才,想請問各位高手大大,還有更快的比對方式嗎?[/size][/color]

ikboy 發表於 2015-9-4 18:11

看您的陣列比對，分明是讓賽一萬倍，給比下來不足為奇，再者您的match 比對在那裡？

PKKO 發表於 2015-9-4 18:15

[quote]看您的陣列比對，分明是讓賽一萬倍，給比下來不足為奇，再者您的match 比對在那裡？
[size=2][color=#999999]ikboy 發表於 2015-9-4 18:11[/color] [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=81676&ptid=15008][img]http://forum.twbts.com/images/common/back.gif[/img][/url][/size][/quote]


    大大您好,小弟若是要抓資料的時候,比對程式碼為Application.VLookup(rng2(i, 1), Sheets("test").Range("A:c"), 3, 0) 的方式

這種方式也是比我原本的陣列方式快很多倍

想請問大大為何說我的陣列比對方式是讓賽一萬倍?

您有何種方式可以更快嗎?還請指教~

准提部林 發表於 2015-9-4 19:50

Ｃ．Ｄ欄為被比對資料，
根據Ａ欄數據，取出與Ｃ欄相同值所對應Ｄ欄數值，並填至Ｂ欄（與VLOOKUP相同）：[code]Sub TEST_Vlookup()
Dim TM, Arr, Brr, xRow&, xD, i&
TM = Timer
[B:B].Clear: [J1] = ""
xRow = 20000
Arr = [A1].Resize(xRow)
Brr = [C1:D1].Resize(xRow)
Set xD = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(Brr)
　　xD(Brr(i, 1)) = Brr(i, 2)
Next
For i = 1 To UBound(Arr)
　　Arr(i, 1) = xD(Arr(i, 1))
Next
[B1].Resize(xRow) = Arr
[J1] = Timer - TM
End Sub[/code]　
附檔還有〔類〕COUNTIF及SUMIF用法，都是字典檔與陣列的運用（２萬筆，１秒內完成，可能嗎？？？），
很普通的VBA，請自行參酌，恕不另作說明：
[attach]21907[/attach]
　　

ikboy 發表於 2015-9-4 21:14

便用字典來代替Vlookup, 建議套用lcase or ucase, 因字典會分大小寫，字典+陣列，肯定是利害的組合。

PKKO 發表於 2015-9-4 22:44

[quote]Ｃ．Ｄ欄為被比對資料，
根據Ａ欄數據，取出與Ｃ欄相同值所對應Ｄ欄數值，並填至Ｂ欄（與VLOOKUP相同）：　 ...
[size=2][color=#999999]准提部林 發表於 2015-9-4 19:50[/color] [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=81680&ptid=15008][img]http://forum.twbts.com/images/common/back.gif[/img][/url][/size][/quote]


大大厲害!

您的程式碼小弟承接了

這是我看過最快的方式了

我用傳統的比對方式要35秒(大約),Vlookup的方式要5秒

您的方式只需要0.1x秒,速度上快了將近50倍....太威了

小弟想請教一下,您舉的例子是A 欄比對 C  ,然後取出D

若將題目改A 比對C ,然後得到D,再用D去比對F然後取出G,最後才將G 輸入到B 欄位的話
下方是我用您的方式寫出來的,不曉得如果是大大您本人來撰寫的話,也是會用相同的方式嗎?
還是會用不同的寫法?(更便利or更清楚or更快)
麻煩大大了,大大您的這段程式碼,震撼到小弟了,附檔的部分,會再花時間看,有問題再向大大您請教哦![code]Sub TEST_Vlookup()
'Ｃ．Ｄ欄為被比對資料，
'根據A欄數據 , 取出與C欄相同值所對應D欄數值, 並填至B欄(與VLOOKUP相同):

Dim TM, Arr, Brr, xRow&, xD, i&
TM = Timer
[B:B].Clear: [J1] = ""
xRow = 20000
Arr = [A1].Resize(xRow)
Brr = [C1:D1].Resize(xRow)
Crr = [f1:g1].Resize(xRow)
Set xD = CreateObject("Scripting.Dictionary")
'C的D
For i = 1 To UBound(Brr)
    xD(Brr(i, 1)) = Brr(i, 2)
Next
'比對結果得到D
For i = 1 To UBound(Arr)
    Arr(i, 1) = xD(Arr(i, 1))
Next
'多加了part1-----------------------(F的G)
For i = 1 To UBound(Arr)
    xD(Crr(i, 1)) = Crr(i, 2)
Next
'多加了part2-----------------------(比對結果得到G)
For i = 1 To UBound(Arr)
    Arr(i, 1) = xD(Arr(i, 1))
Next


[B1].Resize(xRow) = Arr
[J1] = Timer - TM
End Sub[/code]

bobomi 發表於 2015-9-4 23:06

[i=s] 本帖最後由 bobomi 於 2015-9-4 23:07 編輯 [/i]

[b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=81688&ptid=15008]6#[/url] [i]PKKO[/i] [/b]


之前你自己不是秀過一段程式碼
你自己裡面就用字典在搜尋

PKKO 發表於 2015-9-5 01:05

[quote]回復  PKKO


之前你自己不是秀過一段程式碼
你自己裡面就用字典在搜尋
[size=2][color=#999999]bobomi 發表於 2015-9-4 23:06[/color] [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=81689&ptid=15008][img]http://forum.twbts.com/images/common/back.gif[/img][/url][/size][/quote]

有哦![code]'宣告物件
Dim D As Object
Set D = CreateObject("SCRIPTING.DICTIONARY")  '字典物件
'判定是否存在於物件之內
If not D.Exists(cstr(E)) Then
        D.Add cstr(E), I
END IF
Ar=d.keys
'移除物件內的所有物件
   'D.RemoveAll
[/code]但我不曉得原來字典物件還可以有那樣的用法,我只會這種而已
但他那種方式感覺比我這種好用,就連我上述的程式碼,應該也可以改為他的方式(還沒測試過速度差異)
因為不用跑比對的迴圈,只要跑一次本身,感覺速度快很多

准提部林 發表於 2015-9-5 10:29

[b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=81688&ptid=15008]6#[/url] [i]PKKO[/i] [/b]


〔雙重比對〕取出對應值：[code]Sub TEST_Vlookup()
Dim TM, Arr, Brr, Crr, Xrr, xRow&, xD, i&
TM = Timer:　 [B:B,E:E].Clear:　 [M1] = ""
xRow = 20000
Arr = [A1].Resize(xRow)
Brr = [C1:D1].Resize(xRow)
Crr = [F1:G1].Resize(xRow)
　
Set xD = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(Crr)
　xD(Crr(i, 1)) = Crr(i, 2)
Next
　
Xrr = [E1].Resize(xRow) 　'(X1)
For i = 1 To UBound(Brr)
　　If xD.Exists(Brr(i, 2)) Then
　　　　xD(Brr(i, 1)) = xD(Brr(i, 2))
　　　　Xrr(i, 1) = xD(Brr(i, 2)) 　'(X2)
　　End If
Next
[E1].Resize(xRow) = Xrr　 '(X3)
　
Xrr = [B1].Resize(xRow)
For i = 1 To UBound(Arr)
　　If xD.Exists(Arr(i, 1)) Then Xrr(i, 1) = xD(Arr(i, 1))
Next
[B1].Resize(xRow) = Xrr
　
[M1] = Timer - TM
End Sub[/code](X1)(X2)(X3)這三行用來填入Ｅ欄做檢查用，可以刪除：
[attach]21910[/attach]
　
EXCEL及VBA，只是插花非專業，大概寫寫，參考即可∼∼
　

PKKO 發表於 2015-9-12 18:54

[b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=81695&ptid=15008]9#[/url] [i]准提部林[/i] [/b]


    謝謝版主大大,您的程式碼真的很不錯,小弟可否再向版大請教一下

傳統的方式for i 到 for j 的方式 我可以使用 like 來 找出相關文字
ex:
m=0
rng=[a1].currentregion
for i = 1 to ubound(rng)
     for j = 1 to ubound(rng,2)
          if rng(i,j) like "*" & "AA" & "*" then
               m=m+1
          endif
     next
next

那用大大您的陣列+字典的方式呢?要如何辦到?
因為大大您的方式很快速,但目前卡在這邊還請大大指導一下!

准提部林 發表於 2015-9-12 19:50

[b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=81893&ptid=15008]10#[/url] [i]PKKO[/i] [/b]


比對文字還有 Instr 方法，
要看資料結構及需求，才能決定使用何種方式，
請提供相關檔案資料，說明需求及模擬結果，

另，此問題已與此題本意不同，建議另行發帖較妥適，也可讓更多人共同參與討論！
　

Andy2483 發表於 2023-5-9 14:48

[b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=81680&ptid=15008]4#[/url] [i]准提部林[/i] [/b]


    謝謝論壇,謝謝前輩
後學藉此帖學習前輩的方案,學習心得註解如下,請前輩再指導

執行結果:
[attach]36321[/attach]


Sub TEST_Vlookup()
Dim TM, Arr, Brr, xRow&, xD, i&
[color=SeaGreen]'↑宣告變數[/color]
TM = Timer
[B:B].Clear: [J1] = ""
[color=SeaGreen]'↑令結果欄舊資料清除[/color]
xRow = 20000
[color=SeaGreen]'↑令處理列數是2萬列[/color]
Arr = [A1].Resize(xRow)
[color=SeaGreen]'↑令Arr變數是二維陣列,以A欄儲存格值帶入[/color]
Brr = [C1:D1].Resize(xRow)
[color=SeaGreen]'↑令Brr變數是二維陣列,以C.D欄儲存格值帶入[/color]
Set xD = CreateObject("Scripting.Dictionary")
[color=SeaGreen]'↑令xD變數是字典[/color]
For i = 1 To UBound(Brr)
[color=SeaGreen]'↑設順迴圈[/color]
    xD(Brr(i, 1)) = Brr(i, 2)
[color=SeaGreen]    '↑令以Brr陣列第一欄值當key,item是Brr陣列第二欄值,納入xD字典裡[/color]
Next
For i = 1 To UBound(Arr)
[color=SeaGreen]'↑設順迴圈[/color]
    Arr(i, 1) = xD(Arr(i, 1))
[color=SeaGreen]    '↑令以Arr陣列值查xD字典,將回傳值取代原來的陣列值,
    '若查不到會回傳空字元取代原來的陣列值[/color]
Next
[B1].Resize(xRow) = Arr
[color=SeaGreen]'↑令Arr陣列值帶入B欄[/color]
[J1] = Timer - TM
End Sub

查看完整版本: 最快速的比對資料方式?