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

Question

我是 VBA 的新手，正在为如何将这两个 subs 合并为一个想法而苦苦思索，因为我需要为两个单独的 Pivots 启用动态过滤器。

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

我认为重构有更多选择。

将基本例程放入模块中的单独子程序中。然后可以从两个 sheet 的 _change-events 调用这个 sub。优势：如果你想改变 sub 的逻辑 - 你可以在一个地方做，而不是两个。或者可能会有第三个 sheet 想要使用相同的逻辑。（DRY-原则：不要重复自己）

如有必要，我喜欢将 on error resume next“外化”到 tryGet 函数中。从而最大限度地降低使用它的风险（在这种情况下是可以的）

这是通用子 - 基于 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

这就是您在作品sheet 事件中的称呼方式：

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

顺便说一句：这是将检查放入子项的另一个优点。阅读更改事件中的代码时，您会立即知道会发生什么 - 您无需通读所有代码行即可了解发生了什么。

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

How to Merge Two Worksheet_Change events into one

excel

vba

pivot-table