无法复现的Excel工具文件性能问题诊断求助

我为客户开发了一款带动态下拉菜单的Excel工具，大量使用动态数组（Dynamic Arrays）。工具通过Worksheet_Change事件代码实现两个核心功能：

• 隐藏/取消隐藏未使用行，仅显示数组计算结果
• 主下拉菜单变更时，清除从属下拉菜单内容

文件大小仅207KB，早期版本客户可正常使用，但随着版本迭代，卡顿、数据无法显示的问题逐渐加剧，现在文件已完全无法使用。我在自己的电脑、丈夫的台式机和笔记本上测试，均无法复现问题。

客户已将文件保存到受信任位置以启用宏，且其销售经理也遇到相同问题，说明不是个例。客户发回的文件在我这边运行正常，排除了邮件传输或互联网文件的影响。客户忙且技术能力有限，难以获取更多细节。

客户反馈了一个临时解决方案：

我把正在处理的版本完成后保存到单独的安全文件夹，再从该文件夹重新打开，重复这个流程就能让文件正常运行、避免崩溃，多试几次有效。

我无法确定问题原因，附上Worksheet_Change事件代码，请求排查是否为代码导致的问题。

Private Sub Worksheet_Change(ByVal Target As Range)

    On Error GoTo Errorhandler1
    
    Dim wb As Workbook
    Set wb = ThisWorkbook
    
    If Not wb Is ActiveWorkbook Then
        Exit Sub
    End If
    
    If ActiveSheet.Name <> "Template" Then
        Exit Sub
    End If
    
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    Dim CheckCell As Range
    'clears the relevant bits of the template if the cart base model is changed
    
    'clears whichever margin cell is not in use
    If Not Intersect(Target, Range("Margin_1")) Is Nothing Then
        Range("margin_2").ClearContents
    ElseIf Not Intersect(Target, Range("margin_2")) Is Nothing Then
        Range("Margin_1").ClearContents
    End If
    
    ' checks if any of base model, lifted / non lifted or cart model or street legal have been changed
    If Not Intersect(Target, Range("ChangeCell_2")) Is Nothing Or _
            Not Intersect(Target, Range("ChangeCell_3")) Is Nothing Or _
            Not Intersect(Target, Range("ChangeCell_4")) Is Nothing Or _
            Not Intersect(Target, Range("ChangeCell_5")) Is Nothing Or _
            Not Intersect(Target, Range("ChangeCell_6")) Is Nothing Or _
            Not Intersect(Target, Range("ChangeCell_7")) Is Nothing Then
        On Error Resume Next
        If Not Intersect(Target, Range("ChangeCell_2")) Is Nothing Then
            'if cart base model is changed
            Range("ChangeCell_3").ClearContents 'clears lifted / non lifted
            Range("ChangeCell_4").ClearContents 'clears number of passengers
            Range("ChangeCell_5").ClearContents 'clears battery type
            Range("ChangeCell_6").ClearContents 'clears engine type
            Range("ChangeCell_7").ClearContents 'clears motor/ street legal
            Range("ChangeCell_8").ClearContents 'clears standard / extended range
            Application.ScreenUpdating = True
            Range("Base_Car_Header").Activate
            Application.ScreenUpdating = False
        ElseIf Not Intersect(Target, Range("ChangeCell_4")) Is Nothing Then
            'if number of passengers is changed
            Range("ChangeCell_6").ClearContents 'clears engine type
            Range("ChangeCell_7").ClearContents 'clears motor/ street legal
            Range("ChangeCell_8").ClearContents 'clears standard vs extended range
        ElseIf Not Intersect(Target, Range("ChangeCell_5")) Is Nothing Then
            'if battery type is changed
            Range("ChangeCell_8").ClearContents 'clears standard vs extended range
        ElseIf Not Intersect(Target, Range("ChangeCell_6")) Is Nothing Then
            'if engine type is changed
            Range("ChangeCell_7").ClearContents 'clears motor/ street legal
        End If
    
        'if cart is 4 person lithium ion, enter default range as standard
        If Range("changecell_4") = 4 And Range("changecell_5") = Worksheets("Dropdowns").Range("LithiumIon") Then
            Range("changecell_8") = Worksheets("Dropdowns").Range("Default_Range")
        End If
    
        'clears all the appropriate ranges when inputs are changed
        Dim i As Integer
        For i = 1 To 20
            On Error Resume Next
            Range("Clear_" & i).ClearContents
        Next
        Range("Assemblies_QTY").ClearContents
        Range("Assemblies_UnitCost").ClearContents
        Range("Assemblies_Notes").ClearContents
        Range("Assemblies_Adjustments").ClearContents
        
        'Hides the rows that are not needed for this cart
        Dim Rw As Range
        For i = 1 To 6
            On Error Resume Next
            For Each Rw In Range("Hide_Rows_" & i)
                If IsEmpty(Rw) Then
                    If Rw.EntireRow.Hidden = False Then
                        Rw.EntireRow.Hidden = True
                    End If
                Else
                    Rw.EntireRow.Hidden = False
                    Rw.EntireRow.AutoFit
                End If
            Next
        Next
    
    End If
    
    ' if the active cell is in the cosmetics choices then just do the cosmetics section
    If Not Application.Intersect(Target, Range("Clear_1")) Is Nothing Then
        Application.ScreenUpdating = False
        Application.EnableEvents = False
        On Error Resume Next
        For Each Rw In Range("Cosmetics_Headers")
            If IsEmpty(Rw) Then
                If Rw.EntireRow.Hidden = False Then
                    Rw.EntireRow.Hidden = True
                End If
            Else
                Rw.EntireRow.Hidden = False
                Rw.EntireRow.AutoFit
            End If
        Next
    End If
    
    ' if the active cell is in the accessories choices then just do the accessories summary section
    If Not Application.Intersect(Target, Range("Accessories_Changes")) Is Nothing Then
        Application.ScreenUpdating = False
        Application.EnableEvents = False
        On Error Resume Next
        For Each Rw In Range("Accessories_Headers")
            If IsEmpty(Rw) Then
                If Rw.EntireRow.Hidden = False Then
                    Rw.EntireRow.Hidden = True
                End If
            Else
                Rw.EntireRow.Hidden = False
                Rw.EntireRow.AutoFit
            End If
        Next
        Application.ScreenUpdating = True
        Application.EnableEvents = True
    End If
    
    'if the active cell is in the assemblies choices then just do the assemblies section
    If Not Application.Intersect(Target, Range("Clear_2")) Is Nothing Then
        Application.ScreenUpdating = False
        Application.EnableEvents = False
        On Error Resume Next
        For Each Rw In Range("Assemblies_Detail")
            If IsEmpty(Rw) Then
                If Rw.EntireRow.Hidden = False Then
                    Rw.EntireRow.Hidden = True
                End If
            Else
                Rw.EntireRow.Hidden = False
                Rw.EntireRow.AutoFit
            End If
        Next
        For Each Rw In Range("Assemblies_Headers")
            If IsEmpty(Rw) Then
                If Rw.EntireRow.Hidden = False Then
                    Rw.EntireRow.Hidden = True
                End If
            Else
                Rw.EntireRow.Hidden = False
                Rw.EntireRow.AutoFit
            End If
        Next
        'clear out qty and adjs if assemblies options are chosen
        Range("Assemblies_QTY").ClearContents
        Range("Assemblies_UnitCost").ClearContents
        Range("Assemblies_Notes").ClearContents
        Range("Assemblies_Adjustments").ClearContents
    End If
    
    ' if the active cell is in the accessories choices then just do the accessories summary section
    If Not Application.Intersect(ActiveCell, Range("Clear_7")) Is Nothing Or _
            Not Application.Intersect(ActiveCell, Range("Clear_13")) Is Nothing Then
        Application.EnableEvents = False
        On Error Resume Next
        For Each Rw In Range("Accessories_Headers")
            If IsEmpty(Rw) Then
                If Rw.EntireRow.Hidden = False Then
                    Rw.EntireRow.Hidden = True
                End If
            Else
                Rw.EntireRow.Hidden = False
                Rw.EntireRow.AutoFit
            End If
        Next
    End If
    
    'clears qty and unit cost data for assemblies if option 1 is changed
    If Not Intersect(Target, Range("Assemblies_Input_1")) Is Nothing Then
        Range("Assemblies_QTY").ClearContents
        Range("Assemblies_UnitCost").ClearContents
        Range("Assemblies_Notes").ClearContents
    End If
    
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    
    Exit Sub
    
Errorhandler1:
    MsgBox ("Something has gone wrong with the Worksheet Change macro. Please contact the developer.")
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Exit Sub
    
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub

1. 滥用On Error Resume Next #

代码中多处无差别使用该语句，会掩盖真实错误（如命名范围不存在、单元格引用错误），导致问题无法被及时发现。建议仅在明确需要忽略特定错误的场景使用，其余场景移除，让错误暴露便于排查。

2. 重复设置应用程序状态 #

• 开头已设置ScreenUpdating=False和EnableEvents=False，后续分支重复设置甚至提前开启（如ChangeCell_2分支中临时开启ScreenUpdating），会导致界面刷新混乱，增加卡顿概率。
• 部分分支提前开启EnableEvents，可能触发重复的Worksheet_Change事件，造成循环执行，加剧卡顿。

3. 错误使用ActiveCell判断触发源 #

处理Clear_7和Clear_13的分支中，用ActiveCell判断触发源，但Worksheet_Change的触发源是Target，用户操作后ActiveCell可能与Target不一致，导致逻辑错误。应统一使用Target判断。

4. 行隐藏逻辑性能低下 #

多次循环遍历行并设置隐藏状态，且每次调用AutoFit，会消耗大量Excel资源。建议：

• 先批量收集需要隐藏/显示的行，再一次性设置状态，减少Excel对象操作次数
• 仅在必要时调用AutoFit，或批量对需要显示的行执行一次AutoFit

5. 动态数组重计算冲突 #

大量使用动态数组时，数组公式重计算可能与Worksheet_Change事件执行冲突。建议在事件开头添加Application.Calculation = xlCalculationManual，结束后恢复为xlCalculationAutomatic，避免重计算干扰。

6. 错误处理信息不足 #

当前错误处理仅弹出通用提示，无法记录具体错误代码和位置。建议修改错误处理：

Errorhandler1:
    MsgBox "错误代码：" & Err.Number & vbCrLf & "错误描述：" & Err.Description & vbCrLf & "请联系开发者。"
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Exit Sub

7. 文件状态推测 #

客户的临时解决方案说明文件可能存在损坏的临时缓存或碎片化问题。建议：

• 让客户尝试另存为.xlsm文件，覆盖原文件
• 建议客户清理Excel临时文件（路径：%APPDATA%\Microsoft\Excel）

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