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

问题描述

编辑：使这种方式更简单。 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

解决方法

应该看起来更像这样：

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

onchange onchange vba