VBA Worksheet_Change事件For循环触发Error 5错误求助

我在编写Worksheet_Change变更宏时，For循环频繁触发**"Invalid procedure call or argument (Error 5)"**错误。已确认变量定义无误，尝试多种方法仍无法解决。错误集中在以下代码段（另一处完全相同的For循环也会报错）：

For i = 18 To 26
    Newvalueb = .Cells(i, tarcol).Formula
    If Len(Newvalueb) = "12" Then
    Else
        Newvalue = Mid(Newvalueb, 12, Len(Newvalueb) - 18)
        .Cells(i, tarcol).Value = "=SUM(" & .Cells(i, "E").Address & "," & Newvalue & ")"
    End If
Next i

通常在执行Newvalue = Mid(Newvalueb, 12, Len(Newvalueb) - 18)时触发错误，偶尔该行无问题，后续赋值语句也会报错。此循环在另一CommandButton关联代码中可正常运行，但在Worksheet_Change事件中无法执行，十分诡异。

完整代码如下：

Private Sub Worksheet_Change(ByVal Target As Range)

Dim i, lastcol, tarcol As Long
Dim Newvalueb As String
Dim Newvalue As Variant

'On Error GoTo Exitsub

ActiveSheet.Unprotect Password:=""

With ActiveSheet

    Application.EnableEvents = True
   
    

    For i = 73 To 62 Step -1
        If IsEmpty(.Cells(i, "B").Value) = True Then
        Else
            If IsEmpty(.Cells(i, "G").Value) = True Then
                GoTo Hide
            Else
            End If
        End If
    Next i

    .Range("G12:L12").EntireRow.Hidden = False
End With
GoTo Cont

Hide:
ActiveSheet.Range("G12:L12").EntireRow.Hidden = True
GoTo Cont

Cont:

    Application.EnableEvents = True
    If Range("J12").Value = "APPROVED" Then
            
    lastcol = ActiveSheet.Cells(17, Columns.Count).End(xlToLeft).Column
    tarcol = lastcol - 3
            
        With ActiveSheet
    
            '.Shapes("CommandButton3").Delete
            '.Shapes("CommandButton2").Delete
            '.Shapes("CommandButton1").Delete

            '.Cells.Locked = False
            '.Cells.Locked = True

            For i = 18 To 26
                Newvalueb = .Cells(i, tarcol).Formula
                If Len(Newvalueb) = "12" Then
                Else
                    Newvalue = Mid(Newvalueb, 12, Len(Newvalueb) - 18)
                    .Cells(i, tarcol).Value = "=SUM(" & .Cells(i, "E").Address & "," & Newvalue & ")"
                End If
            Next i
            
            
            For i = 35 To 53
                Newvalueb = .Cells(i, tarcol).Formula
                If Len(Newvalueb) = "12" Then
                Else
                    Newvalue = Mid(Newvalueb, 12, Len(Newvalueb) - 18)
                    .Cells(i, tarcol).Value = "=SUM(" & .Cells(i, "E").Address & "," & Newvalue & ")"
                End If
            Next i
    
            If .Cells(17, tarcol - 2).Value > 1 Then
                .Range(.Cells(16, tarcol - 2), .Cells(27, tarcol - 1)).Delete xlShiftToLeft
                .Range(.Cells(33, tarcol - 2), .Cells(54, tarcol - 1)).Delete xlShiftToLeft
            Else
            End If

        End With
    Else
    End If
    
Exitsub:

ActiveSheet.Protect Password:="", _
UserInterfaceOnly:=True, _
Contents:=True, _
AllowFormattingCells:=False, _
AllowFormattingColumns:=False, _
AllowFormattingRows:=False, _
AllowInsertingColumns:=False, _
AllowInsertingRows:=False, _
AllowDeletingColumns:=False, _
AllowDeletingRows:=False

End Sub

错误原因分析 #

1. Mid函数参数非法：当Len(Newvalueb) < 18时，Len(Newvalueb)-18会得到负数，而Mid函数的长度参数不能为负，直接触发Error 5。
2. 事件递归触发：代码中修改单元格值会再次触发Worksheet_Change事件，导致变量状态混乱，而你两次设置Application.EnableEvents = True，完全未禁用事件，这是核心问题。
3. 变量定义不严谨：Dim i, lastcol, tarcol As Long中仅tarcol为Long类型，i和lastcol默认是Variant类型，易引发隐性类型转换错误。
4. 字符串与数值错误比较：Len(Newvalueb) = "12"是将数值（Len返回Long）与字符串比较，虽VBA会隐性转换，但易引发未知问题。

修复后的代码 #

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim i As Long, lastcol As Long, tarcol As Long
    Dim Newvalueb As String
    Dim Newvalue As Variant

    ' 禁用事件，防止递归触发
    Application.EnableEvents = False
    ActiveSheet.Unprotect Password:=""

    With ActiveSheet
        ' 简化行隐藏判断逻辑
        Dim hideRow As Boolean
        hideRow = False
        For i = 73 To 62 Step -1
            If Not IsEmpty(.Cells(i, "B").Value) Then
                If IsEmpty(.Cells(i, "G").Value) Then
                    hideRow = True
                    Exit For ' 找到符合条件的行即退出循环
                End If
            End If
        Next i
        .Range("G12:L12").EntireRow.Hidden = hideRow
    End With

    If Range("J12").Value = "APPROVED" Then
        With ActiveSheet
            lastcol = .Cells(17, Columns.Count).End(xlToLeft).Column
            tarcol = lastcol - 3

            ' 处理第一组行
            For i = 18 To 26
                Newvalueb = .Cells(i, tarcol).Formula
                ' 先检查字符串长度，确保Mid参数合法
                If Len(Newvalueb) > 18 Then
                    Newvalue = Mid(Newvalueb, 12, Len(Newvalueb) - 18)
                    .Cells(i, tarcol).Formula = "=SUM(" & .Cells(i, "E").Address & "," & Newvalue & ")"
                End If
            Next i
            
            ' 处理第二组行
            For i = 35 To 53
                Newvalueb = .Cells(i, tarcol).Formula
                If Len(Newvalueb) > 18 Then
                    Newvalue = Mid(Newvalueb, 12, Len(Newvalueb) - 18)
                    .Cells(i, tarcol).Formula = "=SUM(" & .Cells(i, "E").Address & "," & Newvalue & ")"
                End If
            Next i
    
            If .Cells(17, tarcol - 2).Value > 1 Then
                .Range(.Cells(16, tarcol - 2), .Cells(27, tarcol - 1)).Delete xlShiftToLeft
                .Range(.Cells(33, tarcol - 2), .Cells(54, tarcol - 1)).Delete xlShiftToLeft
            End If
        End With
    End If

Exitsub:
    ' 恢复事件和工作表保护
    Application.EnableEvents = True
    ActiveSheet.Protect Password:="", _
        UserInterfaceOnly:=True, _
        Contents:=True, _
        AllowFormattingCells:=False, _
        AllowFormattingColumns:=False, _
        AllowFormattingRows:=False, _
        AllowInsertingColumns:=False, _
        AllowInsertingRows:=False, _
        AllowDeletingColumns:=False, _
        AllowDeletingRows:=False
End Sub

关键修复点 #

• 操作前禁用Application.EnableEvents，避免事件递归触发，操作完成后恢复。
• 严格定义所有变量类型，消除Variant带来的隐性转换风险。
• 增加字符串长度检查，确保Mid函数的长度参数为正数。
• 简化行隐藏判断逻辑，用变量标记状态，避免GoTo跳转导致的代码可读性问题。
• 将字符串与数值的错误比较改为直接检查长度是否满足提取条件。

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