帖子: 45
主題: 15
精華: 0
積分: 92
點名: 0
作業系統: ?
軟體版本: ?
閱讀權限: 20
註冊時間: 2016-3-17
最後登錄: 2019-11-19

1^# 跳轉到 » 倒序看帖

打印

字體大小: tT

發表於 2018-6-15 14:50 | 只看該作者

[發問] vlookup速度慢，使用vba取代的程式碼

當遇到資料量十幾萬筆的情況下，使用vlookup函數速度會很慢
詢問google大師有這麼一段程式碼
但是試著套，會出現溢位的錯誤，請問是否能幫忙修改程式碼，謝謝!

取代Vlookup.tar (318 KB)

樓主熱帖

ikboy

中學生 Rank: 2

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

2016猴年全勤獎章

2^#

發表於 2018-6-15 15:20 | 只看該作者

try
dim i as Variant, r as Variant

TOP

chiang0320

中學生 Rank: 2

帖子: 45
主題: 15
精華: 0
積分: 92
點名: 0
作業系統: ?
軟體版本: ?
閱讀權限: 20
註冊時間: 2016-3-17
最後登錄: 2019-11-19

3^#

發表於 2018-6-15 15:45 | 只看該作者

回復 2# ikboy

ikboy 你好:

請問是直接加入這句程式碼嗎?

TOP

ikboy

中學生 Rank: 2

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

2016猴年全勤獎章

4^#

發表於 2018-6-16 10:13 | 只看該作者

更改 dim i %, r% 為 dim i as Variant, r as Variant

TOP

GBKEE

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

5^#

發表於 2018-6-19 06:02 | 只看該作者

回復 1# chiang0320

試試看

Option Explicit
'Option Explicit 為在模組層次中強迫每個在模組裏的變數都必須明確的宣告。
'這是編寫程式易於偵錯的好習慣
Sub Ex()
Dim d As Object, E As Range, Ar(), T As Date
T = Time
Debug.Print "程式開始時間 : " & T '指令->檢視->即時運算視窗 : 查看程式起始時間
'Dim i%= i As Integer
'Integer 資料型態 Integer 變數係以範圍為 -32,768 到 32,767 之 16 位元 (2 個位元組) 數字的形式儲存。Integer 的型態宣告字元是百分比符號(%
'********** 不會溢位 ***********
Dim i As Long '= i&
'Long 資料型態
'Long (長整數)變數係以範圍從 -2,147,483,648 到 2,147,483,647 之 32 位元 (4 個位元組) 有號數字形式儲存。Long 的型態宣告字元為 &。 '
Set d = CreateObject("scripting.dictionary") '字典物件
With Sheets("p10")
For Each E In .Range(.[a1], .[a1].End(xlDown))
d(E.Value) = Array(E.Offset(, 2), E.Offset(, 3))
'e.Value > 字典物件的關鍵字(key) 導入 Array(e.Offset(, 2), e.Offset(, 3))
Next
End With
With Sheets("q72").Range(Sheets("q72").[B2], Sheets("q72").[B2].End(xlDown)).Resize(, 4)
Ar = .Value
For i = 1 To UBound(Ar)
If d.exists(Ar(i, 1)) Then
'Exists 方法如果在 Dictionary 物件中指定的關鍵字存在，傳回 True，若不存在，傳回 False。
Ar(i, 3) = d(Ar(i, 1))(0)
Ar(i, 4) = d(Ar(i, 1))(1)
Else
Ar(i, 3) = "無資料"
Ar(i, 4) = "無資料"
End If
Next
.Value = Ar
End With
Debug.Print "程式結束時間 : " & Time, Application.Text(Time - T, "共計[S]秒")
'指令->檢視->即時運算視窗 : 查看程式運行速度
End Sub

複製代碼

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

TOP

Qin

中學生 Rank: 2

帖子: 207
主題: 61
精華: 0
積分: 270
點名: 0
作業系統: Vista
軟體版本: office2003
閱讀權限: 20
性別: 女
註冊時間: 2011-3-20
最後登錄: 2023-6-25

6^#

發表於 2018-11-4 00:26 | 只看該作者

回復 5# GBKEE

套用了你的程式碼, 但是速度滿慢的, 不知道問題出在那里?
可否請G大幫我看看..
謝謝!!

Dictionary.rar (850.66 KB)

TOP

n7822123

　暱稱: 阿龍

中學生 Rank: 2

帖子: 406
主題: 8
精華: 0
積分: 453
點名: 0
作業系統: WINDOWS 7
軟體版本: 2007
閱讀權限: 20
性別: 男
來自: 台灣
註冊時間: 2015-2-7
最後登錄: 2021-7-31

7^#

發表於 2018-11-4 03:53 | 只看該作者

本帖最後由 n7822123 於 2018-11-4 03:54 編輯

回復 6# Qin

字典物件的Key 如果輸入的是 "字串"，會加快速度
這招準大已經用過不少次，多爬文就知道了
看的有點痛苦，幫你縮排了

Option Explicit
Sub Ex()
Dim d As Object, E As Range, Ar(), T As Date
T = Time
Debug.Print "最宒羲宎奀潔 : " & T
Dim i As Long
Set d = CreateObject("scripting.dictionary")
With Sheets("Data")
  For Each E In .Range(.[a1], .[a1].End(xlDown))
d(E.Value & "") = Array(E.Offset(, 1), E.Offset(, 2), E.Offset(, 3))
  Next
End With

With Sheets("Search").Range(Sheets("Search").[a2], Sheets("Search").[a2].End(xlDown)).Resize(, 4)
  Ar = .Value
  For i = 1 To UBound(Ar)
   If d.exists(Ar(i, 1)) Then
   Ar(i, 2) = d(Ar(i, 1) & "")(0)
   Ar(i, 3) = d(Ar(i, 1) & "")(1)
   Ar(i, 4) = d(Ar(i, 1) & "")(2)
Else
   Ar(i, 2) = "No Data"
   Ar(i, 3) = "No Data"
   Ar(i, 4) = "No Data"
End If
  Next
  .Value = Ar
End With

Debug.Print "最宒賦旰奀潔 : " & Time, Application.Text(Time - T, "僕數[S]鏃")
End Sub

Dictionary.rar (834.78 KB)

程式是依需求寫的，需求表達不清楚
或者沒有上傳附件，愛莫能助

TOP

准提部林

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 2834
主題: 10
精華: 0
積分: 2890
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2024-11-22

8^#

發表於 2018-11-4 09:59 | 只看該作者

E As Range
For Each E In .Range(.[a1], .[a1].End(xlDown))

next

這段改成Array會再加快速度~~

TOP

准提部林

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 2834
主題: 10
精華: 0
積分: 2890
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2024-11-22

9^#

發表於 2018-11-4 10:34 | 只看該作者

Sub Ex_01()
Dim xD, Arr, Brr, i&, j%, R&, Tm
Tm = Time
Set xD = CreateObject("scripting.dictionary")
Arr = Range([Data!D1], [Data!A1].Cells(Rows.Count, 1).End(3))
For i = 2 To UBound(Arr): xD(Arr(i, 1) & "") = i: Next

Brr = Range([Search!D1], [Search!A1].Cells(Rows.Count, 1).End(3))
For i = 2 To UBound(Brr)
R = Val(xD(Brr(i, 1) & ""))
For j = 1 To 3
Brr(i - 1, j) = "No Data"
If R > 0 Then Brr(i - 1, j) = Arr(R, j + 1)
Next j
Next i

[Search!B2:D2].Resize(UBound(Brr) - 1) = Brr
MsgBox Time - Tm
End Sub

TOP

n7822123

　暱稱: 阿龍

中學生 Rank: 2

帖子: 406
主題: 8
精華: 0
積分: 453
點名: 0
作業系統: WINDOWS 7
軟體版本: 2007
閱讀權限: 20
性別: 男
來自: 台灣
註冊時間: 2015-2-7
最後登錄: 2021-7-31

10^#

發表於 2018-11-5 01:23 | 只看該作者

本帖最後由 n7822123 於 2018-11-5 01:32 編輯

回復 9# 准提部林

原來把儲存格資料放到數組陣列後，再裝到字典裡面
會比直接拿儲存格的值放入字典裡面來的快!!
這有點違反直覺...........

以下是我拿準大的程式碼做一些修改來做比較
明顯test_1 比較快

Sub test_1()
Dim T1, d, R%, Arr
T1 = Timer
Set d = CreateObject("scripting.dictionary")
Arr = Range([data!A1], [data!D1].End(4))
For R = 2 To UBound(Arr)
d(Arr(R, 1) & "") = R
Next R
MsgBox "共耗時" & Round(Timer - T1, 2) & "秒"
End Sub

Sub test_2()
Dim T1, d, R%
T1 = Timer
Set d = CreateObject("scripting.dictionary")
Sheets("data").Activate
For R = 2 To [A1].End(4).Row
d(Cells(R, 1) & "") = R
Next R
MsgBox "共耗時" & Round(Timer - T1, 2) & "秒"
End Sub

程式是依需求寫的，需求表達不清楚
或者沒有上傳附件，愛莫能助

TOP