如何将两个Worksheet_Change事件合并为一个

Question

我是相当新的VBA和如何合并这两个子为一个的想法，因为我需要启用动态过滤器为两个单独的轴。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim xPTable As PivotTable
Dim xPFile As PivotField
Dim xStr As String
On Error Resume Next
If Intersect(Target, Range("L3:L4")) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Set xPTable = Worksheets("Summary").PivotTables("PivotTable1")
Set xPFile = xPTable.PivotFields("Machine")
xStr = Target.Text
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr
Application.ScreenUpdating = True
End Sub

与此结合

Private Sub Worksheet_Change(ByVal Target As Range)
Dim xPTable As PivotTable
Dim xPFile As PivotField
Dim xStr As String
On Error Resume Next
If Intersect(Target, Range("P16:P17")) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Set xPTable = Worksheets("Summary").PivotTables("PivotTable2")
Set xPFile = xPTable.PivotFields("Machine")
xStr = Target.Text
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr
Application.ScreenUpdating = True
End Sub

感谢任何帮助，谢谢!

Answer 1

如果有交叉路口，就把车翻过来继续行驶，而不是在没有交叉路口的情况下退出。

你的代码，重构和其他一些改进

Private Sub Worksheet_Change(ByVal Target As Range)
Dim xPTable As PivotTable
Dim xPFile As PivotField
Dim xStr As String
Application.ScreenUpdating = False
If Target.CountLarge > 1 Then
' User changed >1 cells.  What now?
Exit Sub
End If

' On Error Resume Next   <~~ don't do this globally!
If Not Intersect(Target, Me.Range("L3:L4")) Is Nothing Then
On Error Resume Next '<~~ Keep it tight around a potential error
' If the Change event is on Sheet Summary, use Me instead
Set xPTable = Me.PivotTables("PivotTable1")
' If the Change Event is NOT on Sheet Summary, be explicit on the workbook
'Set xPTable = Me.Parent.Worksheets("Summary").PivotTables("PivotTable1")
On Error GoTo 0
ElseIf Not Intersect(Target, Me.Range("P16:P17")) Is Nothing Then
On Error Resume Next 
Set xPTable = Me.PivotTables("PivotTable2")
On Error GoTo 0
End If

If Not xPTable Is Nothing Then
On Error Resume Next '<~~ in case Machine doesn't exist
Set xPFile = xPTable.PivotFields("Machine")
On Error GoTo 0
If Not xPFile Is Nothing Then
xStr = Target.Value  ' .Text is dangerous. Eg it can truncate if the column is too narrow
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr
End If
End If
Application.ScreenUpdating = True
End Sub

Answer 2

我认为重构有更多的选择。

将基本例程放入模块的单独子程序中。然后可以从两个表的_change-events调用这个子表。优点:如果你想改变子元素的逻辑，你可以在一个位置做，而不是两个位置。或者可能会有第三张表想要使用相同的逻辑。(dry原则:不要重复)

我喜欢"外化"。on error resume next(如果必要的话)到tryGet-functions中。从而最大限度地降低其使用的风险(在本例中是ok)

这是基于chris neilsens的建议加上VBasic2008的评论的通用子目录

也许您可以调整子标题以更精确地达到您想要达到的效果。

Public Sub handleMachineField(Target As Range, RangeToCheck As Range, PTName As String)
On Error GoTo err_handleMachineField
Dim xPTable As PivotTable
Dim xPFile As PivotField
Dim xStr As String
Application.ScreenUpdating = False

If Target.CountLarge > 1 Then
' User changed >1 cells.  What now?
Exit Sub
End If

If Not Intersect(Target, RangeToCheck) Is Nothing Then
Set xPTable = tryGetPivotTable(Target.Parent, PTName)
End If

If Not xPTable Is Nothing Then
Set xPFile = tryGetPivotField(xPTable, "Machine")
If Not xPFile Is Nothing Then
xStr = Target.Value  ' .Text is dangerous. Eg it can truncate if the column is too narrow
Application.EnableEvents = False
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr
Application.EnableEvents = True
End If
End If

exit_handleMachineField:
Application.ScreenUpdating = True
Application.EnableEvents = True
Exit Sub
err_handleMachineField:
MsgBox Err.Description
Resume exit_handleMachineField

End Sub

Public Function tryGetPivotTable(ws As Worksheet, PTName As String) As PivotTable
'in case pivot table does not exist no error is thrown
'calling sub has to check for nothing instead
On Error Resume Next
Set tryGetPivotTable = ws.PivotTables(PTName)
On Error GoTo 0
End Function
Public Function tryGetPivotField(pt As PivotTable, FieldName As String) As PivotField
'in case field does not exist no error is thrown
'calling sub has to check for nothing instead
On Error Resume Next
Set tryGetPivotField = pt.PivotFields(FieldName)
On Error GoTo 0
End Function

你可以这样调用工作表事件:

Private Sub Worksheet_Change(ByVal Target As Range)
handleMachineField Target, Me.Range("L3:L4"), "PivotTable1"
End Sub

顺便说一下:这是将check放入子代码中的另一个优点。在阅读change-event中的代码时，您可以立即知道将发生什么—您不必通读所有代码行来了解发生了什么。