Excel VBA代码中断恢复/切换应用后提速的原因及优化咨询

我有一个大型Excel VBA项目，包含数百个仅存储数据无计算的工作表，代码存在不够规范的部分。项目已做防屏幕闪烁处理（多数时候设置ScreenUpdating=False），仅显示一个任务信息工作表和一个通过ProgressWindow.Show实现的进度条，在工业场景运行时部分报告耗时数小时。

偶然发现以下操作可大幅加快代码执行：

• 按中断后恢复代码运行
• 切换至其他应用

为此设置了两个选项按钮：

• “info”关闭：隐藏任务信息工作表
• “bar”关闭：隐藏进度条

测试数据如下：

咨询问题 #

1. 为何显示进度条（IsProgressBarOff=False）时程序运行更快？
2. 为何上述交互操作能加快程序运行？
3. 如何在代码中利用此类交互实现提速？

附相关代码：

Sub ShowProgressBar(info)

    If IsProgressBarOff Then Exit Sub

    'activate progress bar
    ProgressWindow.FullBar.Width = 0

    'progress text
    ProgressWindow.ProgressInfo.Caption = ""

    'progress titel
    ProgressWindow.Caption = info
    ProgressWindow.Show

    'positioning progress window
    ProgressWindow.Top = Application.Top + (StartUpWindow.Height / 3) + 115      
    ProgressWindow.Left = (Application.Left + 280)
End Sub

Sub Sample()
  ' some code
  ShowProgressBar "Loop1"
  nr = 1
    For Each s In Application.Sheets
      
       SetProgressBar_A nr, s.Name  

       ' some code which will take some seconds

       nr = nr + 1
    Next s
End Sub


Sub SetProgressBar_A(incr, info)

     If verifyVisual_IsProgressBarOff Then Exit Sub    
    
    'change bar
    If incr > 100 Then incr = 100
    If incr < 2 Then incr = 2
    ProgressWindow.FullBar.Width = incr * 3
    
    'show info
    ProgressWindow.ProgressInfo.Caption = info
    
    ProgressWindow.Repaint

    DoEvents    
End Sub

问题解答 #

1. 显示进度条时程序更快的原因 #

你的进度条更新代码里包含ProgressWindow.Repaint和DoEvents两个关键语句：

• DoEvents会强制Excel处理当前积压的Windows消息队列，避免UI线程长时间被VBA代码独占导致的调度阻塞。当进度条开启时，每次循环都会触发DoEvents，让Excel有机会处理后台的系统级任务（比如内存管理、窗口消息），防止VBA代码陷入“独占线程”的死循环状态，反而提升了整体执行效率。
• 对比关闭进度条的场景，代码中没有了DoEvents调用，VBA会持续占用Excel的主线程，系统无法及时处理后台资源调度，导致代码执行时出现隐性的资源等待，拖慢了整体速度。

另外，隐藏任务信息工作表减少了UI渲染的开销，但进度条的存在通过DoEvents触发了系统级的调度优化，带来的性能提升远超过进度条本身的渲染消耗。

2. 交互操作加快运行的原因 #

按ESC中断后恢复、切换到其他应用这些操作，本质上是触发了Windows的线程调度机制：

• 当你执行这些操作时，Windows会向Excel发送窗口消息（比如焦点变更、中断信号），强制Excel的主线程暂停VBA执行，去处理这些外部消息。这相当于手动触发了DoEvents的效果，让Excel有机会清理积压的后台任务、释放闲置资源，重新调度线程优先级。
• 恢复代码运行后，VBA执行时的资源环境已经得到优化，不再有之前的调度阻塞，因此运行速度大幅提升。

3. 代码中利用此类交互实现提速的方法 #

基于上述原理，可以通过以下方式在代码中模拟这种交互的优化效果：

（1）定时调用DoEvents

不需要依赖进度条，在循环或耗时操作中定期插入DoEvents，但要注意不要过于频繁（比如每处理10个工作表调用一次），避免过度消耗CPU：

Sub Sample()
    ' 其他初始化代码
    nr = 1
    For Each s In Application.Sheets
        ' 处理工作表的代码
        
        nr = nr + 1
        ' 每处理10个工作表触发一次DoEvents
        If nr Mod 10 = 0 Then
            DoEvents
        End If
    Next s
End Sub

（2）保留进度条并优化其渲染

如果进度条的用户体验很重要，可以保留它，但优化SetProgressBar_A的代码，减少不必要的渲染开销：

Sub SetProgressBar_A(incr, info)
    If verifyVisual_IsProgressBarOff Then Exit Sub    
    ' 仅当进度或信息有变化时才更新，避免重复渲染
    Static lastIncr As Integer, lastInfo As String
    If incr = lastIncr And info = lastInfo Then Exit Sub
    
    lastIncr = incr
    lastInfo = info
    
    If incr > 100 Then incr = 100
    If incr < 2 Then incr = 2
    ProgressWindow.FullBar.Width = incr * 3
    ProgressWindow.ProgressInfo.Caption = info
    
    ProgressWindow.Repaint
    DoEvents    
End Sub

（3）手动触发系统消息处理

如果不想用DoEvents（因为它会让代码响应外部中断），可以调用Windows API来处理消息队列，效果类似但更可控：

' 声明API函数
Private Declare PtrSafe Function PeekMessage Lib "user32" Alias "PeekMessageA" _
    (lpMsg As Msg, ByVal hWnd As LongPtr, ByVal wMsgFilterMin As Long, _
    ByVal wMsgFilterMax As Long, ByVal wRemoveMsg As Long) As LongPtr

Private Declare PtrSafe Function TranslateMessage Lib "user32" _
    (lpMsg As Msg) As LongPtr

Private Declare PtrSafe Function DispatchMessage Lib "user32" Alias "DispatchMessageA" _
    (lpMsg As Msg) As LongPtr

Private Type Msg
    hwnd As LongPtr
    message As Long
    wParam As LongPtr
    lParam As LongPtr
    time As Long
    pt_x As Long
    pt_y As Long
End Type

Sub ProcessSystemMessages()
    Dim msg As Msg
    ' 处理所有积压的消息
    Do While PeekMessage(msg, 0&, 0&, 0&, 1&)
        TranslateMessage msg
        DispatchMessage msg
    Loop
End Sub

然后在代码中调用ProcessSystemMessages替代DoEvents，既能处理系统消息，又不会让VBA响应ESC等中断信号。

（4）优化Excel的运行环境

• 确保ScreenUpdating=False、EnableEvents=False、Calculation=xlCalculationManual这些基础优化选项已开启，减少无关的后台操作。
• 避免在循环中频繁操作工作表对象，尽量将数据读入数组处理，再一次性写入工作表，减少Excel的IO开销。

内容的提问来源于stack exchange，提问作者CH Oldie