12
返回列表 上一主題 發帖

[發問] 最快速的比對資料方式?

PKKO
　暱稱: PKKO

高中生Rank: 3Rank: 3

帖子
549 
主題
152 
精華
0 
積分
691 
點名
0  
作業系統
WIN7 
軟體版本
OFFICE 2010 
閱讀權限
50 
性別
男 
註冊時間
2013-8-10 
最後登錄
2022-9-7 

論壇榮譽勳章論壇贊助勳章
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2015-9-4 16:31 | 只看該作者

[發問] 最快速的比對資料方式?

本帖最後由 PKKO 於 2015-9-4 16:34 編輯

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

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

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

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

  4. rng2 = [b1].Resize(20000, 1).Value
  5. For i = 1 To 20000
  6.     Application.Match(rng2(i, 1), Sheets("test").Range("A:A"), 0)
  7. Next
  8. T2 = Hour(Now()) * 3600 + Minute(Now()) * 60 + Second(Now())
  9. MsgBox "共耗時 " & T2 - t1 & " 秒"
  10. End Sub
複製代碼
小弟不才,想請問各位高手大大,還有更快的比對方式嗎?
收藏 分享
PKKO

ikboy

帖子
262 
主題
8 
精華
0 
積分
280 
點名
17  
作業系統
xp 
軟體版本
Office 2007 
閱讀權限
20 
性別
男 
來自
HK 
註冊時間
2015-8-11 
最後登錄
2024-11-19 

2016猴年全勤獎章
2#
發表於 2015-9-4 18:11 | 只看該作者
看您的陣列比對，分明是讓賽一萬倍，給比下來不足為奇，再者您的match 比對在那裡？

TOP

PKKO
　暱稱: PKKO

高中生Rank: 3Rank: 3

帖子
549 
主題
152 
精華
0 
積分
691 
點名
0  
作業系統
WIN7 
軟體版本
OFFICE 2010 
閱讀權限
50 
性別
男 
註冊時間
2013-8-10 
最後登錄
2022-9-7 

論壇榮譽勳章論壇贊助勳章
3#
發表於 2015-9-4 18:15 | 只看該作者
看您的陣列比對，分明是讓賽一萬倍，給比下來不足為奇，再者您的match 比對在那裡？
ikboy 發表於 2015-9-4 18:11



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

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

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

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

TOP

准提部林

帖子
2834 
主題
10 
精華
0 
積分
2890 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2024-11-22 
4#
發表於 2015-9-4 19:50 | 只看該作者
Ｃ．Ｄ欄為被比對資料，
根據Ａ欄數據，取出與Ｃ欄相同值所對應Ｄ欄數值，並填至Ｂ欄（與VLOOKUP相同）：
  1. Sub TEST_Vlookup()
  2. Dim TM, Arr, Brr, xRow&, xD, i&
  3. TM = Timer
  4. [B:B].Clear: [J1] = ""
  5. xRow = 20000
  6. Arr = [A1].Resize(xRow)
  7. Brr = [C1:D1].Resize(xRow)
  8. Set xD = CreateObject("Scripting.Dictionary")
  9. For i = 1 To UBound(Brr)
  10. 　　xD(Brr(i, 1)) = Brr(i, 2)
  11. Next
  12. For i = 1 To UBound(Arr)
  13. 　　Arr(i, 1) = xD(Arr(i, 1))
  14. Next
  15. [B1].Resize(xRow) = Arr
  16. [J1] = Timer - TM
  17. End Sub
複製代碼
　
附檔還有〔類〕COUNTIF及SUMIF用法，都是字典檔與陣列的運用（２萬筆，１秒內完成，可能嗎？？？），
很普通的VBA，請自行參酌，恕不另作說明：
Test20150904.rar (374.9 KB)
　　

TOP

ikboy

帖子
262 
主題
8 
精華
0 
積分
280 
點名
17  
作業系統
xp 
軟體版本
Office 2007 
閱讀權限
20 
性別
男 
來自
HK 
註冊時間
2015-8-11 
最後登錄
2024-11-19 

2016猴年全勤獎章
5#
發表於 2015-9-4 21:14 | 只看該作者
便用字典來代替Vlookup, 建議套用lcase or ucase, 因字典會分大小寫，字典+陣列，肯定是利害的組合。

TOP

PKKO
　暱稱: PKKO

高中生Rank: 3Rank: 3

帖子
549 
主題
152 
精華
0 
積分
691 
點名
0  
作業系統
WIN7 
軟體版本
OFFICE 2010 
閱讀權限
50 
性別
男 
註冊時間
2013-8-10 
最後登錄
2022-9-7 

論壇榮譽勳章論壇贊助勳章
6#
發表於 2015-9-4 22:44 | 只看該作者
Ｃ．Ｄ欄為被比對資料，
根據Ａ欄數據，取出與Ｃ欄相同值所對應Ｄ欄數值，並填至Ｂ欄（與VLOOKUP相同）：　 ...
准提部林 發表於 2015-9-4 19:50



大大厲害!

您的程式碼小弟承接了

這是我看過最快的方式了

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

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

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

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

  5. Dim TM, Arr, Brr, xRow&, xD, i&
  6. TM = Timer
  7. [B:B].Clear: [J1] = ""
  8. xRow = 20000
  9. Arr = [A1].Resize(xRow)
  10. Brr = [C1:D1].Resize(xRow)
  11. Crr = [f1:g1].Resize(xRow)
  12. Set xD = CreateObject("Scripting.Dictionary")
  13. 'C的D
  14. For i = 1 To UBound(Brr)
  15.     xD(Brr(i, 1)) = Brr(i, 2)
  16. Next
  17. '比對結果得到D
  18. For i = 1 To UBound(Arr)
  19.     Arr(i, 1) = xD(Arr(i, 1))
  20. Next
  21. '多加了part1-----------------------(F的G)
  22. For i = 1 To UBound(Arr)
  23.     xD(Crr(i, 1)) = Crr(i, 2)
  24. Next
  25. '多加了part2-----------------------(比對結果得到G)
  26. For i = 1 To UBound(Arr)
  27.     Arr(i, 1) = xD(Arr(i, 1))
  28. Next


  31. [B1].Resize(xRow) = Arr
  32. [J1] = Timer - TM
  33. End Sub
複製代碼
PKKO

TOP

bobomi

帖子
181 
主題
5 
精華
0 
積分
197 
點名
0  
作業系統
XP 
軟體版本
2000 
閱讀權限
20 
性別
女 
註冊時間
2014-3-9 
最後登錄
2024-4-29 
7#
發表於 2015-9-4 23:06 | 只看該作者
本帖最後由 bobomi 於 2015-9-4 23:07 編輯

回復 6# PKKO


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

TOP

PKKO
　暱稱: PKKO

高中生Rank: 3Rank: 3

帖子
549 
主題
152 
精華
0 
積分
691 
點名
0  
作業系統
WIN7 
軟體版本
OFFICE 2010 
閱讀權限
50 
性別
男 
註冊時間
2013-8-10 
最後登錄
2022-9-7 

論壇榮譽勳章論壇贊助勳章
8#
發表於 2015-9-5 01:05 | 只看該作者
回復  PKKO


之前你自己不是秀過一段程式碼
你自己裡面就用字典在搜尋
bobomi 發表於 2015-9-4 23:06


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

TOP

准提部林

帖子
2834 
主題
10 
精華
0 
積分
2890 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2024-11-22 
9#
發表於 2015-9-5 10:29 | 只看該作者
回復 6# PKKO


〔雙重比對〕取出對應值：
  1. Sub TEST_Vlookup()
  2. Dim TM, Arr, Brr, Crr, Xrr, xRow&, xD, i&
  3. TM = Timer:　 [B:B,E:E].Clear:　 [M1] = ""
  4. xRow = 20000
  5. Arr = [A1].Resize(xRow)
  6. Brr = [C1:D1].Resize(xRow)
  7. Crr = [F1:G1].Resize(xRow)
  8. 　
  9. Set xD = CreateObject("Scripting.Dictionary")
  10. For i = 1 To UBound(Crr)
  11. 　xD(Crr(i, 1)) = Crr(i, 2)
  12. Next
  13. 　
  14. Xrr = [E1].Resize(xRow) 　'(X1)
  15. For i = 1 To UBound(Brr)
  16. 　　If xD.Exists(Brr(i, 2)) Then
  17. 　　　　xD(Brr(i, 1)) = xD(Brr(i, 2))
  18. 　　　　Xrr(i, 1) = xD(Brr(i, 2)) 　'(X2)
  19. 　　End If
  20. Next
  21. [E1].Resize(xRow) = Xrr　 '(X3)
  22. 　
  23. Xrr = [B1].Resize(xRow)
  24. For i = 1 To UBound(Arr)
  25. 　　If xD.Exists(Arr(i, 1)) Then Xrr(i, 1) = xD(Arr(i, 1))
  26. Next
  27. [B1].Resize(xRow) = Xrr
  28. 　
  29. [M1] = Timer - TM
  30. End Sub
複製代碼
(X1)(X2)(X3)這三行用來填入Ｅ欄做檢查用，可以刪除：
Test20150904v2.rar (689.08 KB)
　
EXCEL及VBA，只是插花非專業，大概寫寫，參考即可∼∼
　

TOP

PKKO
　暱稱: PKKO

高中生Rank: 3Rank: 3

帖子
549 
主題
152 
精華
0 
積分
691 
點名
0  
作業系統
WIN7 
軟體版本
OFFICE 2010 
閱讀權限
50 
性別
男 
註冊時間
2013-8-10 
最後登錄
2022-9-7 

論壇榮譽勳章論壇贊助勳章
10#
發表於 2015-9-12 18:54 | 只看該作者
回復 9# 准提部林


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

傳統的方式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

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

TOP

        靜思自在 : 修行要繫緣修心，藉事練心，隨處養心。
12
返回列表 上一主題