字典使用(MS脚本库)和其他方法来改善数据行数超过100000行的excel文件在vba中的执行时间

Question

考虑这样一个场景，即您有一堆资产，并且您有与每种类型的资产相关联的数字。我们正在将这些数字从集合A更改为集合B，因此我正在编写一个脚本，以原始集合A的数字为基础，在excel的新列中填充集合B的一些值。每套有11万件商品。

由于信息分散在很多表格中，我采用了VBA方法。我的原始代码通过简单的字符串比较执行：

Public Function SearchSAP(StkCd As Long) As Long
    Dim wb As Workbook
    Dim shSAP As Worksheet
    Dim i As Long
    ' SAP sheet name is fixed and does not change
    Set wb = ActiveWorkbook
    Set shSAP = wb.Worksheets("SAP")
    ' i is the start row of the SAP sheet for data
    i = 2
    ' Define no-match value as -1
    SearchSAP = -1        
    Do While i < shSAP.UsedRange.Rows.Count And i < 106212
        If shSAP.Cells(i, 1).value = Stkcd Then
            SearchSAP = shSAP.Cells(i, 2).value
            Exit Do
        End If
        i = i + 1
    Loop
    Set shSAP = Nothing
    Set wb = Nothing
End Function

这个功能花了我很长时间才执行，在i7网络2.4 GHz内核上可能需要15-20分钟。我差点以为我用无限循环把它编码错了。当它最终给我"-1"时，我意识到它确实花了那么长时间。在研究stackoverflow时，我发现了"如何优化vlookup以获得高搜索次数？"（vlookup的替代品）"这似乎表明字典是最好的选择。所以我尝试了一下：

Public Function SearchSAP(StkCd As Long) As Long
    Dim wb As Workbook
    Dim shSAP As Worksheet
    Dim Dict As New Scripting.Dictionary
    Dim i As Long
    ' SAP sheet name is fixed and does not change
    Set wb = ActiveWorkbook
    Set shSAP = wb.Worksheets("SAP")
    ' i is the start row of the SAP sheet for data
    i = 2
    ' Define null value as -1
    SearchSAP = -1
    Do While i < shSAP.UsedRange.Rows.Count And i < 106212
        Dict.Add shSAP.Cells(i, 1).value, shSAP.Cells(i, 2).value
        i = i + 1
    Loop
    Do While i < shSAP.UsedRange.Rows.Count And i < 106212
        If Dict.Exists(StkCd) Then
            SearchSAP = Dict(StkCd)
            Exit Do
        End If
        i = i + 1
        If i = 150000 Then
            Debug.Print "Break"
        End If
    Loop
    Set shSAP = Nothing
    Set wb = Nothing
End Function

但这个功能仍然花了大约5分钟的时间才弄清楚。我的问题是，我是不是以一种相当愚蠢的方式来处理这个问题？我怎样才能更有效地做到这一点？我不是一个全职程序员，所以我不确定我能做些什么来优化它。任何帮助都会很棒！

Answer 1

Public Function SearchSAP(StkCd As Long) As Long
    Static Dict As scripting.dictionary 'precerved between calls
    Dim i As Long, arr
    If Dict Is Nothing Then
        'create and populate dictionary
        Set Dict = New scripting.dictionary
        With ActiveWorkbook.Worksheets("SAP")
            arr = .Range(.Range("A2"), _
                         .Cells(.Rows.Count, "A").End(xlUp).Offset(0, 1)).Value
        End With
        For i = 1 To UBound(arr, 1)
            Dict.Add arr(i, 1), arr(i, 2)
        Next i
    End If
    If Dict.exists(cstr(StkCd)) Then
        SearchSAP = CLng(Dict(cstr(StkCd)))
    Else
        SearchSAP = -1
    End If
End Function