代码之家 › 专栏 › 技术社区 › PL200

更快的vba vlookup替代基于密钥检索数据

vlookup vba excel

1

PL200 · 技术社区 · 8 年前

我正在尝试匹配一个大型数据集,并使用vba将值从一个工作表复制到另一个工作表。我目前正在使用vlookup,但是这个过程对于我正在测试的单个列来说太慢了,以至于它不可行。有没有一种更有效的方法来匹配基于密钥的数据?基本上,我的数据是这样的,在这里我试图使用“key”将“data”从数据集A复制到B

数据集A:

Key  Data
123  yes
231  yes
435  no

Dataset B:

Key  Data
453  
231

我目前的代码如下:

    Sub copyData()

Dim myLastRow As Long
Dim backlogSheet As Worksheet
Dim combinedSheet As Worksheet

Set backlogSheet = Sheets("All SAMs Backlog")
Set combinedSheet = Sheets("COMBINED")
myLastRow = backlogSheet.Cells(Rows.Count, "B").End(xlUp).Row

Application.ScreenUpdating = False

For myRow = 3 To myLastRow

    curLoc = backlogSheet.Cells(myRow, "C")

    searchVal = Range("D" & myRow).Value

    statusVal = Application.VLookup(curLoc, combinedSheet.Range("A:B"), 2, False)

    'Range("D" & myRow).Cells.Value = testVal
Next myRow

MsgBox ("done")
End Sub

如有任何帮助,我们将不胜感激。

1 回复 | 直到 8 年前

1

user4039065 8 年前

从源代码填充一个字典,得到一个目标数组并用源字典填充它,最后,将结果数组放回目标工作表。

Sub copyData()
    Dim i As Long, arr As Variant, dict As Object

    Set dict = CreateObject("scripting.dictionary")
    dict.comparemode = vbTextCompare

    With Worksheets("COMBINED")
        'put combined!a:b into a variant array
        arr = .Range(.Cells(2, "A"), .Cells(.Rows.Count, "B").End(xlUp)).Value2
        'loop through array and build dictionary keys from combined!a:a, dictionary item from combined!b:b
        For i = LBound(arr, 1) To UBound(arr, 1)
            dict.Item(arr(i, 1)) = arr(i, 2)
        Next i
    End With

    With Worksheets("All SAMs Backlog")
        'put 'all sams backlog'!c:d into a variant array
        arr = .Range(.Cells(3, "C"), .Cells(.Rows.Count, "C").End(xlUp).Offset(0, 1)).Value2
        'loop through array and if c:c matches combined!a:a then put combined!b:b into d:d
        For i = LBound(arr, 1) To UBound(arr, 1)
            If dict.exists(arr(i, 1)) Then
                arr(i, 2) = dict.Item(arr(i, 1))
            Else
                arr(i, 2) = vbNullString
            End If
        Next i
        'put populated array back into c3 (resized by rows and columns)
        .Cells(3, "C").Resize(UBound(arr, 1), UBound(arr, 2)) = arr
    End With

    MsgBox ("done")

End Sub