Excel VBA脚本优化求助：避免误触发及完善错误处理

• 现有输入模板不可修改，要实现用户输入数字时不破坏单元格原有公式
• 目标单元格范围为C9:C853，示例公式：=WENNFEHLER(AUFRUNDEN(C376/$M$369+P509;0);0)+0
• 当前实现逻辑：选中单元格时存储原公式，单元格变更时拆分公式为「最后一个右括号前的部分」和「右括号后的数值部分」，将用户输入值与该数值相加后重新组合公式
• 已解决多选、全选、双击/F2触发等场景，但错误处理混乱（滥用On Error Resume Next导致Excel崩溃），代码存在优化空间

现有VBA代码 #

Dim OldValues As New Collection

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
If Target.CountLarge = 1 And Not Intersect(Target, Range("C9:C853")) Is Nothing Then
        Set OldValues = Nothing
        OldValues.Add Target.Formula
        Debug.Print OldValues(1)
    End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Target.CountLarge <> 1 Or Target.HasFormula And Target.Formula = OldValues(1) Then Exit Sub
    Dim r As Long, c As Long, ValInput As Long, ValShortFormula As String, ValFormulaEnd As Long
    Dim keyCells As Range: Set keyCells = Range("C9:C853")
    On Error Resume Next
    Set keyCells = Application.Union(keyCells.Precedents, keyCells)
    Application.EnableEvents = False
        If Not Application.Intersect(Target, keyCells) Is Nothing Then
            r = Target.Row
            c = Target.Column
            ValInput = Target.Value
            ValShortFormula = Left(OldValues(1), InStrRev(OldValues(1), ")") - 0)
            ValFormulaEnd = Right(OldValues(1), Len(OldValues(1)) - InStrRev(OldValues(1), ")"))
            Debug.Print OldValues(1)
            Debug.Print ValInput
            Debug.Print ValShortFormula
            Debug.Print ValFormulaEnd
                    Cells(r, c).Formula = ValShortFormula & "+" & ValFormulaEnd + ValInput
                    Set OldValues = Nothing
                    OldValues.Add Target.Formula
        End If
    Application.EnableEvents = True
End Sub

优化改进建议 #

1. 重构错误处理，避免滥用On Error Resume Next #

• 移除全局的On Error Resume Next，针对特定风险代码块单独处理错误，比如获取Precedents时（无引用的单元格调用该属性会报错）：

  Dim tempPrecedents As Range
  On Error Resume Next
  Set tempPrecedents = keyCells.Precedents
  On Error GoTo 0
  If Not tempPrecedents Is Nothing Then
      Set keyCells = Union(keyCells, tempPrecedents)
  End If
  

• 对用户输入值添加类型校验，避免非数字输入导致类型转换错误：

  If Not IsNumeric(Target.Value) Then Exit Sub
  ValInput = CLng(Target.Value)
  

2. 变量与逻辑精简优化 #

• 用单个字符串变量替代OldValues集合（仅需存储当前选中单元格的原公式），避免集合操作的潜在问题：

  Dim OldFormula As String ' 替换原Collection变量
  

• 移除冗余的r、c变量，直接通过Target操作单元格：Target.Formula = ...
• 拆分公式前先确认存在右括号，避免InStrRev返回0导致截取错误：

  Dim lastCloseParen As Long
  lastCloseParen = InStrRev(OldFormula, ")")
  If lastCloseParen = 0 Then Exit Sub
  

3. 提升事件逻辑严谨性 #

• 在Worksheet_SelectionChange中，仅存储带有公式的单元格内容：

  If Target.CountLarge = 1 And Not Intersect(Target, Range("C9:C853")) Is Nothing Then
      OldFormula = IIf(Target.HasFormula, Target.Formula, vbNullString)
  End If
  

• 在Worksheet_Change开头先判断OldFormula是否为空，避免未选中有效单元格时触发错误
• 恢复事件时添加兜底逻辑，确保Application.EnableEvents总能设回True：

  On Error GoTo Cleanup
  ' 核心业务逻辑代码
  Cleanup:
      Application.EnableEvents = True
      If Err.Number <> 0 Then MsgBox "操作出错：" & Err.Description
  

4. 增强公式拆分逻辑准确性 #

• 针对示例公式「末尾为+数字」的结构，改用查找最后一个+的方式提取数值部分，避免公式中存在多个右括号时出错：

  Dim lastPlusPos As Long
  lastPlusPos = InStrRev(OldFormula, "+")
  If lastPlusPos = 0 Then Exit Sub
  
  Dim formulaPrefix As String, numPart As String
  formulaPrefix = Left(OldFormula, lastPlusPos)
  numPart = Mid(OldFormula, lastPlusPos + 1)
  
  If IsNumeric(numPart) Then
      Target.Formula = formulaPrefix & CStr(CLng(numPart) + ValInput)
  End If
  

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