返回列表 上一主題 發帖

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

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

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

5.jpg
2018-6-15 14:49

ss.jpg
2018-6-15 14:47

取代Vlookup.tar (318 KB)

try
dim i as Variant, r as Variant

TOP

回復 2# ikboy

ikboy 你好:

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

TOP

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

TOP

回復 1# chiang0320

試試看
  1. Option Explicit
  2. 'Option Explicit 為 在模組層次中強迫每個在模組堛瘍僂くㄔ眸楨確的宣告。
  3. '這是編寫程式易於偵錯的好習慣
  4. Sub Ex()
  5.     Dim d As Object, E As Range, Ar(), T As Date
  6.     T = Time
  7.     Debug.Print "程式開始時間 : " & T   '指令->檢視->即時運算視窗 :  查看程式起始時間
  8.     'Dim i%= i As Integer
  9.     'Integer 資料型態 Integer 變數係以範圍為 -32,768 到 32,767 之 16 位元 (2 個位元組) 數字的形式儲存。Integer 的型態宣告字元是百分比符號(%
  10.     '********** 不會溢位  ***********
  11.     Dim i As Long  '= i&
  12.     'Long 資料型態
  13.     'Long (長整數)變數係以範圍從 -2,147,483,648 到 2,147,483,647 之 32 位元 (4 個位元組) 有號數字形式儲存。Long 的型態宣告字元為 &。 '

  14.     Set d = CreateObject("scripting.dictionary")  '字典物件
  15.     With Sheets("p10")
  16.         For Each E In .Range(.[a1], .[a1].End(xlDown))
  17.             d(E.Value) = Array(E.Offset(, 2), E.Offset(, 3))
  18.             'e.Value > 字典物件的關鍵字(key) 導入 Array(e.Offset(, 2), e.Offset(, 3))
  19.         Next
  20.     End With
  21.     With Sheets("q72").Range(Sheets("q72").[B2], Sheets("q72").[B2].End(xlDown)).Resize(, 4)
  22.         Ar = .Value
  23.         For i = 1 To UBound(Ar)
  24.             If d.exists(Ar(i, 1)) Then
  25.             'Exists 方法 如果在 Dictionary 物件中指定的關鍵字存在,傳回 True,若不存在,傳回 False。
  26.                 Ar(i, 3) = d(Ar(i, 1))(0)
  27.                 Ar(i, 4) = d(Ar(i, 1))(1)
  28.             Else
  29.                 Ar(i, 3) = "無資料"
  30.                 Ar(i, 4) = "無資料"
  31.             End If
  32.         Next
  33.         .Value = Ar
  34.     End With
  35.     Debug.Print "程式結束時間 : " & Time, Application.Text(Time - T, "共計[S]秒")
  36.     '指令->檢視->即時運算視窗 :  查看程式運行速度
  37. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 5# GBKEE

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

Dictionary.rar (850.66 KB)

TOP

本帖最後由 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

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

next

這段改成Array會再加快速度~~
EXCEL參考資料:
http://blog.xuite.net/smile1000mile/blog

TOP

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
EXCEL參考資料:
http://blog.xuite.net/smile1000mile/blog

TOP

本帖最後由 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

        靜思自在 : 人的心地是一畦田,土地沒有播下好種子,也長不出好的果實。 -
返回列表 上一主題