Excel VBA 宏会意外减速，通常在 DoEvents答案

【问题标题】：Excel VBA macro slows down unpredictably, usually at DoEventsExcel VBA 宏会意外减速，通常在 DoEvents
【发布时间】：2021-02-03 11:10:05
【问题描述】：

可能会发生什么导致 Excel 缓慢爬行，有时会持续一两分钟，有时会持续数小时，并且其工作量分散在对 DoEvents 的调用中？

很遗憾，我无法发布代码，因为似乎没有导致问题的代码。它发生在不同的地方，没有明显的模式。下面是关于我的调查的详细信息。

上周，我的计算机上的 Excel 在运行多年来一直没有出现问题的宏时开始变慢。我在另外两台计算机上测试了相同的宏，但它们似乎没有同样的问题。很难测试，因为它并不总是慢下来，而且它永远不会发生在同一个地方。有时它每分钟执行一次，有时它工作 10 分钟，然后再次执行。我尝试了另外两台计算机大约 30 分钟，但从未发生过。

如果我设置断点，它永远不会变慢。

如果我洒印刷品，它会，但绝不会在同一个地方。

如果我在几分钟后按 Ctrl+Break 宏停止，调试器会像往常一样突出显示当前行，但 Excel 继续使用 25% 的 CPU（即两个内核的 100%）。此时，在 Excel 或 VBA IDE 上的每次单击都是响应式的，但速度很慢。通常需要几分钟才能看到光标移动到单击的位置。有时，如果您等待几分钟，控件会恢复，并且可以按 F8 或 F5 继续执行，但如果 CPU 使用率在 2-3 分钟内没有下降，我通常会终止 Excel。

在调查期间我创建了这个函数：

Sub DoEvents2()
  Dim T As Single
  T = Timer
  DoEvents
  Debug.Print Format(Timer - T, "0.000")
End Sub

并将对DoEvents的调用替换为对DoEvents2的调用，我在调试窗口中看到DoEvents所需的时间总是几千秒，有时几百秒，一次一会儿，没有明显的规律，时间就这样过去了。通常它会达到约 90 秒，有时会更少，有几次持续近一个小时，一旦它第二天仍在运行。

这是使用上述定义的DoEvents2 运行宏后调试窗口上的输出示例：

宏很大，很难在不破坏的情况下移除一块。

一开始我以为问题出在表格上，但我把所有表格都删掉了，问题依旧存在。

然后我尝试处理 volatile 函数：我删除了所有 volatile 函数，但问题仍然存在。另外，Application.CalculationMode 或 Application.EnableEvents 的更改似乎不会触发它。

我检查了是否有可能触发长时间运行的垃圾收集的全局变量，但我没有找到任何东西。另外，我不知道垃圾收集如何运行 12 小时（我让它运行了一整夜，到了早上它仍然存在）。

有时我点击一个运行宏的按钮，该宏使用JsonConverter、正则表达式、http 请求、表单、易失函数等，它按预期运行一两分钟，没有任何问题。然后我点击另一个运行 10 行代码的按钮，它在几百秒内完成。我一次又一次地单击同一个按钮，几次后 Excel 挂起。我不知道它挂在哪里，因为它从不在同一行挂起。

问题开始于上周进行 Windows 更新时，但我不知道它是否相关。从那以后，我一直在努力解决这个问题，但没有成功。

我不能发布任何代码，因为该宏有 14,000 行，并且它发生在任何地方，任何有 DoEvents 的地方，即使它是一个小的 5 行函数。但它似乎受到了之前发生的事情的影响。

所以，我的问题是，会发生什么导致 Excel 缓慢爬行，有时会持续一两分钟，有时会持续数小时，并且它的工作量分散在对 DoEvents 的调用中。

编辑

大约 40 分钟前又发生了一次，我决定让它发泄，希望在我做其他事情时它会停止。 30 分钟后，我按下 Ctrl+Break 试图停止它，一两分钟后它确实停止了，然后我在 VBA IDE 的保存按钮上单击了几下，希望其中一个能工作，一分钟后或两个弹出窗口显示询问我是否要保存未完成计算的文件。几秒钟后，虽然此弹出窗口可见，但 CPU 使用率变为零。我要求在未完成计算的情况下保存文件，它确实做到了（我可以在标题栏上看到“-Saved”），然后 CPU 继续吸 2 个内核，IDE 仍然突出显示当前行。我尝试了一阵点击停止按钮，但没有奏效（还没有？）。

编辑 2

我在宏中找到了一个地方，如果我设置断点并按 F5，它会始终如一地工作，但如果我删除断点，它会工作一次，然后就会挂起。

这是代码：

T0 = Timer
Debug.Print Application.CalculationState,
DoEvents ' Here I set the breakpoint
Debug.Print Application.CalculationState, Timer - T0

这是在使用断点运行几次后立即窗口上的输出（您会看到我在看到它停止后按 F5 所花费的时间）和两次没有断点的输出。我正在粘贴快照，因为我无法从准备被杀死的悬挂 Excel 中复制。在执行该代码时，计算是手动的并且事件被禁用。我不认为这是在计算。

明天我会尝试重新安装 Office。

编辑 3

卸载并重新安装 Office 没有帮助。

但我认为我发现了一个似乎可以可靠地让 Excel 正常工作或挂起的因素：VPN。

如果我在没有 VPN 连接的情况下启动 Excel，那么我可以毫无问题地工作。如果我然后启动VPN连接，第一次点击（和下面的宏）没有问题，第二次点击很慢，第三次挂起，需要杀死Excel。第二次单击后断开 VPN 没有帮助。我测试了这个场景 5-6 次，结果都是一样的。

我想不出 Excel 会受到 VPN 连接影响的任何原因。唯一安装的插件是我正在努力的插件，它们在本地驱动器上，没有安装第 3 方插件。我的宏不访问任何网络驱动器。有一个类有一个成员Req As New MSXML2.XMLHTTP60，在我的测试中从未使用过。

编辑 4

不，与 VPN 无关。今天我在办公室，没有VPN，问题依然存在。

重新安装 Office 后，我的设置与以前相同。

是否可以重置所有内容并进行全新的、干净的 Office 安装，它不记得以前的任何内容？

【问题讨论】：

您是否安装了任何第三方插件？还是个人插件？
此外，如果您使用excel running slow after windows update 搜索谷歌，您可能会遇到一些有用的信息，例如试图找出您的 Excel 运行缓慢的原因？不知道还有什么可以建议你...
重新安装 office 可能真的有效（但不确定）试一试 :)
@stenci，我遇到了 ActiveX ComboBoxes（选择打印机）的问题，它强制重新计算工作簿中所有自定义功能（显示条形码），即使它不是易失性的。（使用 'OnTime' 调用和不断循环来扫描条码有很多事情要做，但 Combobox 是一个交易破坏者，现在效果很好）。
我提到了 2 个不同的错误。您不需要为 40 个 UDF 调用修复 UDF 错误（尽管 Exit Function 仍然存在错误）。我使用该修复程序是因为我有数百万次 UDF 调用，而且速度是必不可少的。即使您没有 UDF，第二个错误仍可能影响您。请在整个项目中搜索If Application.CalculationState = xlPending Then 之类的内容，如果找到，请确保使用我提到的TryFixingPendingBug 方法。

标签： excel vba doevents

【解决方案1】：

这里有一点更新。我不知道这是否是允许解决问题的答案，但这是我在问题消失之前尝试的最后一件事。

认为文件已损坏，我开始创建一个新文件，从据称已损坏的文件中导入代码和表单，从头开始创建工作表（而不是复制旧的工作表以避免任何重复损坏的风险）我意识到我有一个全局变量和一个名为ShNesting 的工作表。重复的名称不是问题，因为全局变量的范围比工作表对象更窄，因此 VBA 从未见过工作表ShNesting。我检查了 git 存储库，发现它已经工作了 5 年，名称重复没有问题。

我将工作表重命名为Sheet4，问题就消失了。

我试图用损坏的文件的备份副本重现问题，但我无法重现它。我不知道我是否无法重现它，因为备份副本保存在不会重现问题并且我无法重新创建它的条件下，或者我的计算机是否决定自行修复。

我等了几天，我从来没有遇到过问题，所以我想在这里留下一点更新。

【讨论】：

【解决方案2】：

不是真正的解决方案，但评论太长了。
我知道我已经看到了更好的堆栈跟踪过程，但也许修改你的DoEvents2 并在所有UDF、SheetChange 或任何你认为正在运行的例程的顶部添加对TraceRoutines 的调用。将TraceRoutines 上的超时用作断路器。

Public DoingEvents As Boolean
Public TraceList As String
Public LastTime As Single
Public StartTime As Single

Sub DoEvents2()
    StartTime = Timer
    LastTime = StartTime
    If DoingEvents Then
        Debug.Print "Nested DoEvents calls?"
        TraceList = TraceList & "DoEvents" & " (@ " & Format(Timer - LastTime, "0.000") & "s)" & vbCrLf
        Debug.Assert False
    Else
        TraceList = vbNullString
    End If
    DoingEvents = True
    DoEvents
    DoingEvents = False
    Debug.Print Format(Timer - StartTime, "0.000") & " Doing Events"
    Debug.Print TraceList
End Sub

Sub TraceRoutines(Name As String, Optional Timeout As Long = 20)
'Static LastTime As Single
Static TimeoutTriggered As Boolean
    If Timeout = 0 Then TimeoutTriggered = True
    If DoingEvents Then
        TraceList = TraceList & Name & " (@ " & Format(Timer - LastTime, "0.000") & "s)" & vbCrLf
        LastTime = Timer
        If LastTime - StartTime > Timeout Then
            If Not TimeoutTriggered Then
                Debug.Print TraceList
                MsgBox "What is going on here?"
                Debug.Assert False
                TimeoutTriggered = True
            End If
        Else
            'Reset
            TimeoutTriggered = False
        End If
    End If
End Sub

Sub MyFunction()
    TraceRoutines "MyFunction"
End Sub

【讨论】：