結合使用 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()事件。 如果您不得不修改這兩個子程序中的任何一個，您只需要做一次，而不必逐頁進行更新。