含35个分支的VBA Select Case执行过慢，求优化方案

核心优化思路 #

针对遍历整列+多分支Select Case导致的性能问题，优化方向聚焦于减少工作表交互次数和提升规则匹配效率：

1. 只处理有数据的行，避免遍历整列空白行
2. 用内存数组替代单元格循环，降低I/O开销
3. 用字典映射规则，替代顺序执行的Select Case分支
4. 禁用Excel后台冗余操作（屏幕更新、自动计算等）

优化后的代码示例 #

Sub SetNAOptimized()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim iColData As Variant
    Dim ruleDict As Object
    Dim i As Long
    Dim targetCols As Variant
    Dim rng As Range
    
    ' 指定目标工作表
    Set ws = ThisWorkbook.Worksheets("数据录入")
    ' 获取I列最后一行有效数据，避免遍历空白行
    lastRow = ws.Cells(ws.Rows.Count, "I").End(xlUp).Row
    
    ' 创建规则字典：键=I列匹配值，值=需设为"NA"的列（列名/列号数组）
    Set ruleDict = CreateObject("Scripting.Dictionary")
    ' 示例：根据你的35个Case分支替换以下规则
    ruleDict("类型A") = Array("J", "K", "M")
    ruleDict("类型B") = Array("L", "N")
    ruleDict("类型C") = Array("O", "P", "Q")
    ' ... 继续添加剩余规则
    
    ' 禁用Excel后台操作，大幅提升运行速度
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .EnableEvents = False
    End With
    
    ' 将I列数据一次性读入内存数组（比逐单元格读取快100+倍）
    iColData = ws.Range("I1:I" & lastRow).Value
    
    ' 内存中遍历数组，匹配规则并设置值
    For i = 1 To lastRow
        If ruleDict.Exists(iColData(i, 1)) Then
            targetCols = ruleDict(iColData(i, 1))
            ' 批量设置当前行的目标列
            For Each col In targetCols
                ws.Cells(i, col).Value = "NA"
            Next col
        End If
    Next i
    
    ' 进阶优化：若需设置的单元格极多，可先收集范围再一次性赋值
    ' 注释掉上面的循环，启用以下代码进一步提速
    ' Set rng = Nothing
    ' For i = 1 To lastRow
    '     If ruleDict.Exists(iColData(i, 1)) Then
    '         targetCols = ruleDict(iColData(i, 1))
    '         For Each col In targetCols
    '             If rng Is Nothing Then
    '                 Set rng = ws.Cells(i, col)
    '             Else
    '                 Set rng = Union(rng, ws.Cells(i, col))
    '             End If
    '         Next col
    '     End If
    ' Next i
    ' If Not rng Is Nothing Then rng.Value = "NA"
    
    ' 恢复Excel正常状态
    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
        .EnableEvents = True
    End With
End Sub

关键优化点说明 #

• 字典规则映射：将35个Case分支转为字典键值对，规则匹配时间复杂度从O(n)降为O(1)，同时代码更易维护（新增/修改规则只需编辑字典）
• 数组内存操作：一次性读取I列数据到数组，避免循环中频繁访问单元格，这是提升速度的核心
• 有效行范围：通过End(xlUp)获取最后一行数据，彻底避免遍历整列空白行
• 后台操作禁用：关闭屏幕更新、自动计算和事件触发，消除Excel在代码执行中的冗余资源消耗

注意事项 #

• 字典的键需与I列值完全匹配（包括大小写、空格），可通过UCase(iColData(i,1))统一转换大小写来避免匹配失败
• 目标列建议用列号数组（如Array(10,11,13)对应J、K、M列），比列名定位更快
• 测试前请备份数据，避免误操作原始工作表

内容的提问来源于stack exchange，提问作者Jorge Garcia