如何通过VBA专属优化加速慢执行代码（无需算法优化）

你的VBA代码执行速度慢，核心原因之一是频繁和Excel工作表交互，加上一些不必要的重复操作。以下是无需大幅改动原有算法的VBA专属优化方案，能显著提升运行速度：

原代码 #

Option Explicit

Sub Find()
    
    Dim i As Long
    Dim j As Long

    Dim lastRowInResultTable As Long
    lastRowInResultTable = Sheets("result").Cells(Rows.Count, 1).End(xlUp).Row
    
    Dim lastRowISourceTable As Long
    lastRowISourceTable = Sheets("cleared").Cells(Rows.Count, 1).End(xlUp).Row
    
    Dim userName As String
    
    Dim t As Single
    t = Timer

    For i = 2 To 11 'lastRowInResultTable
        
        userName = Sheets("result").Cells(i, "A")
             
        For j = 2 To lastRowISourceTable
        
            Dim month As Integer
            Dim duration As Integer
            Dim counter As Integer
            counter = 0
        
            If Sheets("cleared").Cells(j, "H") = userName Then
                month = Sheets("cleared").Cells(j, "K")
                duration = Sheets("cleared").Cells(j, "L")
                counter = counter + 1
            End If
            
            Select Case month
                Case 10
                    Sheets("result").Cells(i, "B") = duration
                Case 11
                    Sheets("result").Cells(i, "C") = duration
                Case 12
                    Sheets("result").Cells(i, "D") = duration
                Case 1
                    Sheets("result").Cells(i, "E") = duration
                Case 2
                    Sheets("result").Cells(i, "F") = duration
                Case 3
                    Sheets("result").Cells(i, "G") = duration
                Case 4
                    Sheets("result").Cells(i, "H") = duration
                Case 5
                    Sheets("result").Cells(i, "I") = duration
            End Select
            
        Next j
                
    Next i
    
    t = Timer - t
    MsgBox t


End Sub

优化方案与代码 #

1. 核心优化点 #

• 关闭Excel后台功能：暂停屏幕更新、事件触发和自动计算，避免不必要的资源消耗
• 用数组替代单元格直接读写：把源数据和结果数据读入内存数组，大幅减少和工作表的交互次数（这是VBA提速最关键的手段）
• 优化变量作用域：将循环内的变量声明移到外部，避免重复声明的开销
• 精简逻辑：只有匹配到用户时才执行月份判断和赋值，删除无用的counter变量

2. 优化后的代码 #

Option Explicit

Sub OptimizedFind()
    Dim i As Long, j As Long
    Dim lastRowResult As Long, lastRowSource As Long
    Dim userName As String
    Dim month As Integer, duration As Integer
    Dim t As Single
    
    ' 关闭Excel后台消耗型功能
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    
    t = Timer
    
    ' 获取工作表最后一行
    lastRowResult = Sheets("result").Cells(Rows.Count, 1).End(xlUp).Row
    lastRowSource = Sheets("cleared").Cells(Rows.Count, 1).End(xlUp).Row
    
    ' 将源数据一次性读入内存数组
    Dim sourceData As Variant
    sourceData = Sheets("cleared").Range("A2:L" & lastRowSource).Value
    
    ' 将结果表数据读入内存数组
    Dim resultData As Variant
    resultData = Sheets("result").Range("A2:I" & lastRowResult).Value
    
    ' 遍历结果表用户（数组索引从1开始）
    For i = 1 To UBound(resultData, 1)
        userName = resultData(i, 1)
        
        ' 遍历源数据
        For j = 1 To UBound(sourceData, 1)
            If sourceData(j, 8) = userName Then ' 对应原表H列
                month = sourceData(j, 11) ' 对应原表K列
                duration = sourceData(j, 12) ' 对应原表L列
                
                ' 根据月份赋值到对应列
                Select Case month
                    Case 10: resultData(i, 2) = duration ' 对应结果表B列
                    Case 11: resultData(i, 3) = duration ' 对应结果表C列
                    Case 12: resultData(i, 4) = duration ' 对应结果表D列
                    Case 1: resultData(i, 5) = duration ' 对应结果表E列
                    Case 2: resultData(i, 6) = duration ' 对应结果表F列
                    Case 3: resultData(i, 7) = duration ' 对应结果表G列
                    Case 4: resultData(i, 8) = duration ' 对应结果表H列
                    Case 5: resultData(i, 9) = duration ' 对应结果表I列
                End Select
            End If
        Next j
    Next i
    
    ' 将数组数据一次性写入结果表
    Sheets("result").Range("A2:I" & lastRowResult).Value = resultData
    
    ' 恢复Excel原有功能
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    
    t = Timer - t
    MsgBox "执行耗时：" & t & "秒"
End Sub

额外提示 #

如果源数据量极大，还可以给cleared表的H列（用户名）添加工作表索引，进一步提速，但这属于Excel功能辅助，不属于纯VBA代码优化范畴。

内容的提问来源于stack exchange，提问作者Nikita Bugrov