结合使用 Private Sub Worksheet_Change(ByVal Target As Range) 的两个 VBA 术语

Question

我有这个 VBA 代码

Private Sub Worksheet_Change(ByVal Target As Range)

    Application.EnableEvents = False

    If Not Intersect(Target, Range("rngBarcodeInput")) Is Nothing Then
        If Application.CutCopyMode = xlCopy Then
            Application.Undo
            Target.PasteSpecial Paste:=xlPasteValues
        End If

        Range("DJ5").Copy
        Range("rngBarcodeInput").PasteSpecial Paste:=xlPasteFormats
        Range("rngShipCheckInputFieldsNoBarcode").ClearContents
        Range("rngEditStatus").ClearContents
    End If
    Application.EnableEvents = True

End Sub

我想将此代码添加到 VBA 中，但仅在删除上述代码时才有效，因为它们都使用 Worksheet_Change。 合并为一个 Private Sub 的所有组合都不起作用。

Private Sub Worksheet_Change(ByVal Target As Range)

Dim KeyCells As Range

    Set KeyCells = Range("C7")

    If Not Application.Intersect(KeyCells, Range(Target.Address)) _
           Is Nothing Then

        Range("C15").Value = Range("B15").Value
End Sub

Answer 1

我认为这会起作用，前提是您不希望 C15 值的更改导致其他事件触发..

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim KeyCells As Range

    Application.EnableEvents = False

    If Not Intersect(Target, Range("rngBarcodeInput")) Is Nothing Then
        If Application.CutCopyMode = xlCopy Then
            Application.Undo
            Target.PasteSpecial Paste:=xlPasteValues
        End If
        Range("DJ5").Copy
        Range("rngBarcodeInput").PasteSpecial Paste:=xlPasteFormats
        Range("rngShipCheckInputFieldsNoBarcode").ClearContents
        Range("rngEditStatus").ClearContents
    End If

    Set KeyCells = Range("C7")

    If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
        Range("C15").Value = Range("B15").Value
    End If

    Application.EnableEvents = True

End Sub

Answer 2

我认为这应该有效：

Private Sub Worksheet_Change(ByVal Target As Range)

    Application.EnableEvents = False

    If Not Intersect(Target, Range("rngBarcodeInput")) Is Nothing Then
        If Application.CutCopyMode = xlCopy Then
            Application.Undo
            Target.PasteSpecial Paste:=xlPasteValues
        End If

        Range("DJ5").Copy
        Range("rngBarcodeInput").PasteSpecial Paste:=xlPasteFormats
        Range("rngShipCheckInputFieldsNoBarcode").ClearContents
        Range("rngEditStatus").ClearContents
    End If

    ' no need for extra variable, just check address directly
    'Dim KeyCells As Range
    'Set KeyCells = Range("C7")

    If Target.Address = "$C$17" Then Range("C15").Value = Range("B15").Value

    Application.EnableEvents = True
End Sub

只需将两种方法的代码放在一起。

Answer 3

虽然其他答案似乎是正确的，但可能有一些实例希望将这两个例程分开，因为它增加了额外的灵活性和调试的便利性。

您可以通过将两个现有例程重命名为您想要的任何名称来实现此目的，然后创建第三个例程来处理更改事件并调用两个单独的子程序。

在此示例中，我们将重命名为sub1和sub2 ，但显然您可以更改为提供更好描述的内容。

---

将处理更改事件的例程。 您只需调用Sub1 & Sub2 ，并传递由事件Target获取的相同参数。

Private Sub Worksheet_Change(ByVal Target As Range)

    sub1 Target
    sub2 Target

End Sub

你原来的套路，改名了：

Private Sub sub1(ByVal Target As Range)

    Application.EnableEvents = False

    If Not Intersect(Target, Range("rngBarcodeInput")) Is Nothing Then
        If Application.CutCopyMode = xlCopy Then
            Application.Undo
            Target.PasteSpecial Paste:=xlPasteValues
        End If

        Range("DJ5").Copy
        Range("rngBarcodeInput").PasteSpecial Paste:=xlPasteFormats
        Range("rngShipCheckInputFieldsNoBarcode").ClearContents
        Range("rngEditStatus").ClearContents
    End If
    Application.EnableEvents = True

End Sub

Private Sub sub2(ByVal Target As Range)

    Dim KeyCells As Range
    Set KeyCells = Range("C7")

    If Not Application.Intersect(KeyCells, Range(Target.Address)) _
           Is Nothing Then

    Range("C15").Value = Range("B15").Value

End Sub

这样做的一个主要好处是，如果您有多个工作表要使用您的代码，您可以将两个例程复制到一个标准模块中。 然后每个工作表都会有调用这些例程的Worksheet_Change()事件。 如果您不得不修改这两个子程序中的任何一个，您只需要做一次，而不必逐页进行更新。