VBA Worksheet_Change事件代码过长运行缓慢，求优化方案

针对你1903行重复的Worksheet_Change代码导致的性能问题，以下是具体的优化方案，核心思路是减少重复判断、批量处理逻辑、禁用不必要的Excel交互：

一、基础性能优化（必加） #

在代码开头添加以下设置，避免事件重复触发、屏幕刷新卡顿和自动计算的额外开销：

Private Sub Worksheet_Change(ByVal Target As Range)
    ' 临时关闭Excel的交互功能
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    ' 确保出错时恢复所有设置
    On Error GoTo Cleanup

    ' ========== 以下是你的业务逻辑 ==========

Cleanup:
    ' 恢复默认设置
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub

二、针对第一段代码的优化（单元格提示文本） #

原代码用大量If判断单元格地址来赋值提示文本，改用字典映射批量管理，避免重复判断：

If Target.Count = 1 Then
    Dim tipDict As Object
    Set tipDict = CreateObject("Scripting.Dictionary")
    
    ' 批量添加单元格地址与提示文本的映射
    tipDict("C9") = "Please insert your purchase order number here"
    tipDict("C53") = "Please insert your purchase amount here"
    tipDict("C97") = "Please insert your purchase amount here"
    ' 更多单元格直接在此添加，无需新增If判断

    Dim Txt As String
    ' 直接通过字典匹配获取文本
    If tipDict.Exists(Target.Address(0, 0)) Then
        Txt = tipDict(Target.Address(0, 0))
        ' 此处可添加你原有的提示逻辑（比如设置单元格批注、提示框等）
    End If
End If

三、针对第二段代码的优化（跨表行隐藏逻辑） #

原代码重复处理B列单元格对应Calculation Sheet的行隐藏，以及B/G列对应Annex1的行隐藏，改用数组存储规则+循环处理，大幅减少重复代码：

' 用数组批量存储所有规则：{触发单元格(B列地址), Calculation Sheet隐藏行范围, Annex1对应行号}
Dim ruleArr As Variant
ruleArr = Array( _
    Array("$B$11", "9:15", 11), _
    Array("$B$12", "16:22", 12), _
    Array("$B$13", "23:29", 13) _
    ' 更多规则直接在此添加数组元素即可
)

' 提前赋值常用工作表，减少重复查找开销
Dim calcSheet As Worksheet, annexSheet As Worksheet
Set calcSheet = ThisWorkbook.Sheets("Calculation sheet")
Set annexSheet = ThisWorkbook.Sheets("Annex1")

Dim i As Long
For i = LBound(ruleArr) To UBound(ruleArr)
    ' 处理Calculation Sheet的行隐藏逻辑
    If Target.Address = ruleArr(i)(0) Then
        calcSheet.Rows(ruleArr(i)(1)).EntireRow.Hidden = (Target.Value = "")
    End If

    ' 处理Annex1的行隐藏逻辑
    Dim triggerRng As Range
    Set triggerRng = Me.Range(ruleArr(i)(0) & ",$G$" & ruleArr(i)(2))
    If Not Application.Intersect(Target, triggerRng) Is Nothing Then
        annexSheet.Rows(ruleArr(i)(2)).Hidden = _
            Len(Me.Range(ruleArr(i)(0)).Value) = 0 Or Me.Range("$G$" & ruleArr(i)(2)).Value <> "Success"
    End If
Next i

四、针对第三段代码的优化（同号行隐藏逻辑） #

原代码逐个判断C列单元格，改用Intersect判断目标范围，直接通过行号关联处理：

' 定义需要处理的C列单元格范围（可扩展为连续范围，比如$C$9:$C$1000）
Dim targetCRng As Range
Set targetCRng = Me.Range("$C$9,$C$10,$C$17")

' 提前赋值Annex1工作表
Dim annexSheet As Worksheet
Set annexSheet = ThisWorkbook.Sheets("Annex1")

If Not Application.Intersect(Target, targetCRng) Is Nothing And Target.Count = 1 Then
    ' 直接用Target的行号对应Annex1的行，无需逐个判断地址
    annexSheet.Rows(Target.Row).EntireRow.Hidden = (Target.Value = "")
End If

额外优化建议 #

• 提前赋值常用对象：把频繁引用的工作表、单元格范围赋值给变量，避免Excel重复查找对象
• 精准范围判断：在代码开头先判断Target是否在所有需要处理的范围内，如果不在直接跳转到Cleanup，减少无效逻辑执行
• 批量操作：如果有多个行需要隐藏/显示，尽量一次性选中范围后操作，不要逐个处理单行
• 避免字符串匹配：尽量用Target.Row/Target.Column或者Intersect替代Target.Address的字符串判断，执行效率更高

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