Worksheet_Change事件触发Method 'Formula' of object 'Range'失败错误求助

错误根源分析 #

出现「Method 'Formula' of object 'Range' failed」错误，核心原因如下：

1. 死循环陷阱：代码中的Do...Loop Until loop_ctr是死循环，loop_ctr初始值为1且从未修改，导致代码无限重复执行，触发多次公式写入操作后抛出错误。
2. 事件递归触发：修改单元格（包括写入公式）前未禁用事件，导致Worksheet_Change被反复触发，引发操作冲突。
3. 保护设置失效：UserInterfaceOnly:=True的保护配置在Excel重启后会失效，若工作表处于完全保护状态，写入公式的操作会被拦截。
4. 错误处理逻辑混乱：错误处理标签直接放在循环内，错误触发后仍继续执行后续代码，无法正确中断或恢复。

修正后的代码 #

Private Sub Worksheet_Change(ByVal Target As Range)
    ' 先禁用事件和屏幕更新，避免递归触发与卡顿
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    On Error GoTo Cleanup ' 统一错误处理出口

    ' 修复UserInterfaceOnly重启失效问题
    If Sheets("Primary").ProtectContents Then
        Sheets("Primary").Unprotect
        Sheets("Primary").Protect UserInterfaceOnly:=True, AllowInsertingRows:=True, AllowDeletingRows:=True
    End If

    ' 仅更新目标行的时长公式，优化性能
    If Not Intersect(Target, Range("B:B,K:K")) Is Nothing Then
        Dim targetRow As Long
        targetRow = Target.Row
        If targetRow >= 2 And targetRow <= 300 Then
            Range("L" & targetRow).Formula = "=K" & targetRow & "-B" & targetRow
        End If
    End If

    ' 简化时间戳逻辑判断
    Select Case Target.Column
        Case 5 ' E列：写入通知时间到B列
            If Target.Value <> "" And Range("B" & Target.Row).Value = "" Then
                Range("B" & Target.Row).Value = Format(Now(), "HH:MM:SS")
            ElseIf Target.Value = "" Then
                Range("B" & Target.Row).Clear
            End If
        Case 7 ' G列：写入派单时间到F列
            If Target.Value <> "" And Range("F" & Target.Row).Value = "" Then
                Range("F" & Target.Row).Value = Format(Now(), "HH:MM:SS")
            ElseIf Target.Value = "" Then
                Range("F" & Target.Row).Clear
            End If
        Case 8 ' H列：写入专家派单时间到F列
            If Target.Value <> "" And Range("F" & Target.Row).Value = "" Then
                Range("F" & Target.Row).Value = Format(Now(), "HH:MM:SS")
            ElseIf Target.Value = "" Then
                Range("F" & Target.Row).Clear
            End If
        Case 10 ' J列：写入解决时间到K列
            If Target.Value <> "" And Range("K" & Target.Row).Value = "" Then
                Range("K" & Target.Row).Value = Format(Now(), "HH:MM:SS")
            ElseIf Target.Value = "" Then
                Range("K" & Target.Row).Clear
            End If
        Case 17 ' Q列：写入休息时间到R列
            If Target.Value <> "" And Range("R" & Target.Row).Value = "" Then
                Range("R" & Target.Row).Value = Format(Now(), "HH:MM:SS")
            ElseIf Target.Value = "" Then
                Range("R" & Target.Row).Clear
            End If
    End Select

Cleanup:
    ' 错误提示与日志输出
    If Err.Number <> 0 Then
        MsgBox "错误：" & Err.Description
        Debug.Print Err.Description
    End If

    ' 恢复应用默认设置
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

关键修改说明 #

• 移除死循环：删掉无意义的Do...Loop结构，避免代码无限重复执行。
• 提前禁用事件：代码开头就禁用EnableEvents，防止修改单元格时递归触发事件。
• 修复保护模式：先检查工作表保护状态，若已保护则先解除再重新启用仅用户界面保护，解决重启后设置失效问题。
• 优化公式写入：仅更新目标行的L列公式，而非全列重写，提升性能并减少冲突。
• 简化逻辑判断：用Select Case替代冗余的ElseIf，让代码结构更清晰。
• 统一错误处理：将错误处理放在最后，确保无论是否出错都能恢复应用设置。

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