组合使用私有子Worksheet_Change(按值目标为范围)的两个 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 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

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

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

在此示例中，我们将重命名为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()事件。 如果您曾经必须修改这两个子中的任何一个，您只需执行一次，而不必逐张进行更新。