2个或多个Worksheet_Change不同的错误处理/ Excel VBA

Question

我试图在一个工作表上分别触发 2 个 Worksheet_Change 事件。

例如，如果我在“C3”中写入一个数字，则一个 vlookup 要么返回名称，要么跳转到 OnError GoTo NoSupplier，如果我在“C9”中写入，另一个 vlookup 要么返回名称，要么跳转到 On Error转到 NoCOMS。

Private Sub Worksheet_Change(ByVal Target As Range)

Dim suppname As String
Dim COMS As String

If Target.Address(0, 0) = "C3" Then
    If Target <> "" Then
        On Error GoTo NoSupp
        suppname = Application.VLookup(Target.Value, Workbooks("Articlepassport.xlsm") _
        .Sheets("Suppliernames").Range("A2:B1000"), 2, False)
        Range("C5") = suppname
    Else
        Range("C5") = ""
    End If
Exit Sub

NoSupp: Range("C5") = "Supplier Data not maintained!"
End If

If Target.Address(0, 0) = "C9" Then
    If Target <> "" Then
        On Error GoTo NoCOMS
        COMS = Application.VLookup(Target.Value, Workbooks("Articlepassport.xlsm") _
        .Sheets("Tabelle2").Range("A2:B11000"), 2, False)
        Range("C11") = COMS
    Else
        Range("C11") = ""
    End If
Exit Sub

NoCOMS: Range("C11") = "COMS does not exist!"
End If
End Sub

Answer 1

您需要添加Application.EnableEvents = False，这样Sub 就不会被多次触发。在离开Sub之前，您需要使用Application.EnableEvents = True将设置恢复为原始值。

注意：我已经删除了您原来的错误处理程序，并添加了一种处理VLookup 错误的方法，方法是添加If IsError(suppname) Then 和If IsError(COMS) Then。

代码

Private Sub Worksheet_Change(ByVal Target As Range)

Dim suppname As Variant
Dim COMS As Variant

Application.EnableEvents = False
If Not Intersect(Range("C3"), Target) Is Nothing Then
    If Target.Value <> "" Then

        suppname = Application.VLookup(Target.Value, Workbooks("Articlepassport.xlsm") _
        .Sheets("SupplierNames").Range("B2:H1000"), 4, False)
        If IsError(suppname) Then
            Range("C5").Value = "Supplier Data not maintained!"
        Else
            Range("C5").Value = suppname
        End If
    Else
       Range("C5") = ""
    End If
End If

If Not Intersect(Range("C9"), Target) Is Nothing Then
    If Target.Value <> "" Then

        COMS = Application.VLookup(Target.Value, Workbooks("Articlepassport.xlsm") _
        .Sheets("Tabelle2").Range("A2:B11000"), 2, False)
        If IsError(COMS) Then
            Range("C11").Value = "COMS does not exist!"
        Else
            Range("C11").Value = ""
        End If
    Else
        Range("C11").Value = ""
    End If
End If
Application.EnableEvents = True ' reset settings when leaving this Sub

End Sub

Answer 2

编辑功能；通常对于工作表更改事件，您应该停用事件（和屏幕更新），然后允许在错误或子完成时重新激活。

重写函数（未测试）

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.Count > 1 Then Exit Sub

On Error GoTo ExitSub
    Application.EnableEvents = False
    Application.ScreenUpdating = False

    Select Case Target
        Case Range("C3")
            If Target.Value = "" Then
                Range("C5") = ""
                GoTo ExitSub
            End If
            Dim SupplierName As String
            On Error Resume Next
            SupplierName = Application.VLookup(Target.Value, Workbooks("Articlepassport.xlsm") _
                .Sheets("SupplierNames").Range("B2:H1000"), 4, False)
            On Error GoTo ExitSub
            Range("C5").Value = IIf(SupplierName <> "", SupplierName, "Supplier data not maintained!")
        Case Range("C9")
            If Target.Value = "" Then
                Range("C11") = ""
                GoTo ExitSub
            End If
            Dim COMS As String
            On Error Resume Next
            COMS = Application.VLookup(Target.Value, Workbooks("Articlepassport.xlsm") _
                .Sheets("Tabelle2").Range("A2:B11000"), 2, False)
            On Error GoTo ExitSub
            Range("C11").Value = IIf(COMS <> "", COMS, "COMS does not exist!")
        Case Else
    End Select

ExitSub:
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub