18K行数据场景下Excel VBA嵌套循环代码优化需求

我正在开发用于仓库库存管控的Excel VBA宏，流程如下：

• 从Excel仓库数据库导出数据，字段包含MSN、Description、Warehouse、Location、Qty；
• 将导出数据存入export_vector()数组；
• 通过嵌套循环在tbl_wh表中匹配MSN&Warehouse&Location组合：
  • 匹配成功时：更新tbl_wh的Qty_update字段，保留最近2条记录+当前值；
  • 匹配失败时：将该新组合作为条目添加至tbl_wh表末尾。

当前问题：处理约18K行数据时，嵌套循环导致宏运行耗时超10分钟，寻求代码优化建议。

以下是简化后的核心代码：

' export_vector() >> array for store the report dump

For i = 1 To last_row_export
    For j = 1 To last_column_export
        export_vector(i, j) = export_sht.Cells(i + 1, j).Value
    Next j
Next i

For i = 1 To last_row_export
    ID_exists = False
    For Each rw In warehouse_sht.ListObjects("tbl_wh").ListRows
        If rw.Range(1) & rw.Range(3) & rw.Range(4) = export_vector(i, 1) & export_vector(i, 3) & export_vector(i, 4) Then
            ID_exists = True
            If rw.Range(5) = "" Then
                rw.Range(5) = "Qty: " & export_vector(i, 5) & " - Date: " & current_time
                rw.Range(5).Font.ColorIndex = 3 'Red
            Else
                split_qty = Split(rw.Range(5), "|")
                split_qty_last = UBound(split_qty())
                Select Case split_qty_last
                    Case 0
                        rw.Range(5) = split_qty(0) & " | " & "Qty: " & export_vector(i, 5) & " - Date: " & current_time
                        rw.Range(9) = export_vector(i, 5)
                        rw.Range(5).Font.ColorIndex = 7 'Purple
                    Case 1
                        rw.Range(5) = split_qty(0) & " | " & split_qty(1) & " | " & "Qty: " & export_vector(i, 5) & " - Date: " & current_time
                        rw.Range(9) = export_vector(i, 5)
                        rw.Range(5).Font.ColorIndex = 8 'Cian
                    Case 2
                        rw.Range(5) = split_qty(1) & " | " & split_qty(2) & " | " & "Qty: " & export_vector(i, 5) & " - Date: " & current_time
                        rw.Range(9) = export_vector(i, 5)
                        rw.Range(5).Font.ColorIndex = 46 'Orange
                End Select
            End If
            Exit For
        End If
    Next rw
    If ID_exists = False Then
        With warehouse_sht.ListObjects("tbl_wh").ListRows.Add
            .Range(1) = export_vector(i, 1)
            .Range(2) = export_vector(i, 2)
            .Range(3) = export_vector(i, 3)
            .Range(4) = export_vector(i, 4)
            .Range(5) = "Qty: " & export_vector(i, 5) & " - Date: " & current_time
            .Range(5).Font.ColorIndex = 10 'Green
            .Range(6) = export_vector(i, 6)
            .Range(7) = export_vector(i, 7)
            .Range(8) = export_vector(i, 8)
        End With
    End If
Next i

宏功能正常，但处理18K行数据时效率极低，耗时超10分钟。

优化建议 #

1. 用字典（Dictionary）替代嵌套循环实现快速匹配 #

嵌套循环的时间复杂度是O(n*m)，18K行数据搭配现有tbl_wh的行数会导致计算量爆炸。用字典存储MSN&Warehouse&Location作为键，对应的数据行对象作为值，匹配时直接通过键查找，时间复杂度降到O(n)，这是提升性能的核心优化点。

示例实现逻辑：

Dim whDict As Object
Set whDict = CreateObject("Scripting.Dictionary")

' 先将现有tbl_wh的数据加载到字典
Dim tbl As ListObject
Set tbl = warehouse_sht.ListObjects("tbl_wh")
Dim rw As ListRow
For Each rw In tbl.ListRows
    Dim key As String
    key = rw.Range(1) & "|" & rw.Range(3) & "|" & rw.Range(4) ' 用分隔符避免键值拼接冲突
    whDict(key) = rw ' 存储整个行对象，方便后续更新
Next rw

' 遍历导出数据，用字典快速匹配
For i = 1 To last_row_export
    key = export_vector(i, 1) & "|" & export_vector(i, 3) & "|" & export_vector(i, 4)
    If whDict.Exists(key) Then
        ' 匹配成功，更新数据，逻辑和原代码一致
        Set rw = whDict(key)
        ' 放入原有的更新逻辑（Qty_update字段处理、颜色设置等）
    Else
        ' 匹配失败，添加新行，同时将新键加入字典
        Set rw = tbl.ListRows.Add
        ' 赋值逻辑和原代码一致
        key = export_vector(i, 1) & "|" & export_vector(i, 3) & "|" & export_vector(i, 4)
        whDict(key) = rw
    End If
Next i

2. 关闭Excel的屏幕更新与事件触发 #

Excel在运行宏时会实时刷新屏幕、触发事件，这会大幅拖慢速度。在宏开头加入以下代码，结尾再恢复：

' 开头关闭
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual ' 手动计算，避免每次单元格更新触发重算

' 宏结尾恢复
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic

3. 批量加载数据到数组，避免逐个单元格读取 #

原代码已经将导出数据存入数组，但可以优化加载方式，直接一次性读取整区域数据到数组，替代逐行逐列循环：

' 替代原有的双层循环加载export_vector
Dim exportRange As Range
Set exportRange = export_sht.Range(export_sht.Cells(2, 1), export_sht.Cells(last_row_export + 1, last_column_export))
export_vector = exportRange.Value

4. 避免频繁操作单元格格式 #

原代码每次更新都设置字体颜色，可改为批量处理：先记录需要变色的行和对应颜色，等所有数据更新完成后，再统一设置格式，减少Excel的格式渲染次数。

5. 改用数组操作整个表数据（可选） #

如果tbl_wh数据量也很大，可以将整个表的数据加载到二维数组，在数组内完成匹配和更新，最后一次性写回表格，进一步减少和Excel界面的交互。

内容的提问来源于stack exchange，提问作者Guillermo Casás Fojo