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

Question

我想在一张工作表上设置 2 个 Worksheet_Change 事件，这些事件是单独触发的。

例如，如果我在 "C3" 中写入一个数字，则 vlookup 要么返回一个名称，要么跳转到 OnError GoTo NoSupplier，如果我在 "C9" 中写入另一个 vlookup 要么返回一个名称或跳转到 On Error GoTo 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

编辑函数；通常对于工作表更改事件，您应该停用事件（和屏幕更新）然后允许 re-activating 出错或子完成。

重写函数（未测试）

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

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

2 or multiple Worksheet_Change different Error Handling / Excel VBA

excel

vba

worksheet

worksheet-function