Question

我在我的vba代码中使用了vlookup函数，但是当我有超过10万行数据时，这将花费太多时间：

Sub getType()
Application.ScreenUpdating = False
Application.Calculation = xlManual
On Error Resume Next
Dim LastRow1 As Long
Dim LastRow2 As Long
Dim Row As Long
Dim Clm As Long


Set ws = Sheets("P")
LastRow1 = ws.Cells(Rows.Count, "A").End(xlUp).Row
Table1 = Sheet2.Range("A2:A" & LastRow1)
Set ws = Sheets("CRI")
    LastRow2 = ws.Cells(Rows.Count, "A").End(xlUp).Row
Table2 = CRI.Range("A2:D" & LastRow2)
Row = Sheet2.Range("J2").Row
Clm = Sheet2.Range("J2").Column

For Each cl In Table1
  Sheet2.Cells(Row, Clm).Value = Application.WorksheetFunction.VLookup(cl, Table2, 4, False)
  Row = Row + 1
Next cl
Calculate

在这里阅读了一些主题，我检查了使用字典可以加快速度，但是我不正确理解概念以在代码上实现解决方案。

此外，table2上没有重复的数据，但是table1包含重复的值。

任何人都可以帮助我将vlookup转换为字典，如果可能的话，请参考一些视频教程，以便我可以学习这个概念？

Answer 1

这是使用字典的很好解释：

https://excelmacromastery.com/vba-dictionary/

别忘了添加“ Microsoft Scripting Runtime”作为对项目的引用。

我进行了一些测试以检查性能。对于一百万行数据，我得到以下结果：

VLookup：27.93秒

字典：20.83秒

字典和数组：2.32秒

您是否考虑过在将值写入表之前使用字典和数组来存储值？该链接将为您提供一些有用的信息：

https://excelmacromastery.com/excel-vba-array/#How_To_Make_Your_Macros_Run_at_Super_Speed

请考虑以下内容（我尝试保留尽可能多的原始代码）：

Application.ScreenUpdating = False
Application.Calculation = xlManual
On Error GoTo Handler

Dim ws As Worksheet

Dim LastRow1 As Long
Dim LastRow2 As Long

Dim i As Long

Dim Table1 As Range
Dim Table2 As Range
Dim cl As Range
Dim r As Range
Dim targetRange As Range

Dim valuesArray As Variant

Dim dict As New Scripting.Dictionary

Dim timeStart As Double
Dim timeInterval As Double

'start a timer to measure performance
timeStart = Timer()

'Get the column of data to search through
Set ws = Sheets("P")
LastRow1 = ws.Cells(Rows.Count, "A").End(xlUp).Row
Set Table1 = ws.Range("A2:A" & LastRow1)

'Get the table of values to search for
Set ws = Sheets("CRI")
LastRow2 = ws.Cells(Rows.Count, "A").End(xlUp).Row
Set Table2 = ws.Range("A2:D" & LastRow2)

'Add the contents of the table you are searching to the dictionary:
'For each row in the table
For Each r In Table2.Rows

    'Add the key and associated value for that key
    dict.Add r.Cells(1, 1).Value, r.Cells(1, 4).Value

Next r

'Dimension an array to fit all of your values
ReDim valuesArray(1 To LastRow1, 1 To 1)

'Use i to allocate the data to the array
i = 1

For Each cl In Table1

    'Set the value of the array element to the value returned by the dictionary
    valuesArray(i, 1) = dict(cl.Value)
    i = i + 1

Next cl

'Set a target range to put your values in and make it the right size to fit your array
Set targetRange = Worksheets("Target").Range("J2").Resize(UBound(valuesArray, 1) - 1)

'Put the array in the target range
targetRange = valuesArray

'Check how much time it took
timeInterval = Timer() - timeStart
Debug.Print timeInterval

Application.ScreenUpdating = True

希望这会有所帮助。

Answer 2

这里有一些测试代码来说明为什么我建议针对工作表上的范围而不是针对数组运行VLOOKUP（这是通过不使用Set Table = ...获得的）

像vlookup这样的工作表公式是为工作表而不是数组而优化的。

针对工作表的查找比数组查找快130倍。

Sub Tester()

    Const NUMR As Long = 100000
    Dim r As Long, arr, t, m, rng

    'Fill some dummy data if not already there
    If Sheet1.Range("A1") = "" Then
        For r = 1 To NUMR
            Sheet1.Cells(r, 1).Resize(1, 4).Value = _
                     Array(CLng(Rnd * NUMR), "A", "B", r)
        Next r
    End If

    Set rng = Sheet1.Range("A1").CurrentRegion
    arr = rng.Value

    'Vlookup against array
    t = Timer
    For r = 1 To 100
        m = Application.VLookup(r, arr, 4, False)
    Next r
    Debug.Print Timer - t '>> 10.28

    'Vlookup against worksheet Range
    t = Timer
    For r = 1 To 100
        m = Application.VLookup(r, rng, 4, False)
    Next r
    Debug.Print Timer - t '>> 0.078

End Sub

VBA：使用字典代替vlookup函数

2 个答案: