On Cell Change 程序突然停止工作 VBA

Question

编辑：使这种方式更简单。 Edit2：将 Target.Application 更改为 Application

以下代码应检测 A 列中任何单元格的变化，并将 B 列中相邻单元格的值更改为“成功”。

这行得通，但现在不行了。

Sub Worksheet_Change(ByVal Target As Range)

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    If Not Intersect(ActiveCell, Range("A:A")) Is Nothing Then
        ActiveCell.Offset(0, 1).Value = "Success"

    End If

    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With

End Sub

Answer 1

应该看起来更像这样：

Sub Worksheet_Change(ByVal Target As Range)
    
    Dim rng As Range, c As Range
    
    Set rng = Application.Intersect(Target, Me.Range("A:A"))
    
    If Not rng Is Nothing Then
        On Error GoTo haveError 'turn on error handling
        Application.EnableEvents = False
        For Each c In rng.Cells 'need to handle a multi-cell update
            c.Offset(0, 1).Value = "Success"
        Next c
        Application.EnableEvents = True
    End If

    Exit Sub 'normal exit

haveError:
    MsgBox Err.Description
    Application.EnableEvents = True 'ensure events aren't left turned off
    
End Sub