修改VBA宏：实现数据透视表日期单选/多选时同步所有透视表筛选

原宏在多选日期时出现全选问题，核心原因是全局错误捕获掩盖了PivotItem匹配失败的异常，同时未限定同步范围。以下是修改后的代码，可实现特定工作表内所有透视表的单选/多选日期筛选同步：

Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
    Dim wsMain As Worksheet
    Dim wsTarget As Worksheet
    Dim ptMain As PivotTable
    Dim pt As PivotTable
    Dim pfMain As PivotField
    Dim pf As PivotField
    Dim pi As PivotItem
    Dim bMI As Boolean
    Dim targetSheetName As String
    
    ' 替换为你的特定工作表名称
    targetSheetName = "指定同步工作表"
    
    Set wsMain = ActiveSheet
    Set ptMain = Target
    Set wsTarget = ThisWorkbook.Worksheets(targetSheetName)
    
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    
    ' 遍历主透视表的所有页字段，仅处理日期字段
    For Each pfMain In ptMain.PageFields
        If pfMain.Name = "日期" Then
            bMI = pfMain.EnableMultiplePageItems
            
            ' 仅同步特定工作表内的透视表
            For Each pt In wsTarget.PivotTables
                ' 跳过触发事件的原透视表
                If wsMain.Name & "_" & ptMain.Name <> wsTarget.Name & "_" & pt.Name Then
                    pt.ManualUpdate = True
                    Set pf = pt.PivotFields(pfMain.Name)
                    
                    With pf
                        .ClearAllFilters
                        .EnableMultiplePageItems = bMI
                        
                        If Not bMI Then
                            ' 单选模式：同步选中的日期
                            .CurrentPage = pfMain.CurrentPage.Value
                        Else
                            ' 多选模式：逐个同步日期项的可见状态
                            .CurrentPage = "(All)"
                            For Each pi In pfMain.PivotItems
                                On Error Resume Next ' 捕获当前透视表不存在该日期项的情况
                                .PivotItems(pi.Name).Visible = pi.Visible
                                On Error GoTo 0
                            Next pi
                        End If
                    End With
                    
                    Set pf = Nothing
                    pt.ManualUpdate = False
                End If
            Next pt
        End If
    Next pfMain
    
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

修改说明 #

• 限定同步范围：通过targetSheetName指定需要同步的工作表，仅对该表内的10个透视表进行操作
• 修复多选逻辑：移除全局错误捕获，改用局部错误处理避免因透视表数据源差异导致的PivotItem不存在问题，确保每个日期项的可见状态正确同步
• 精准字段匹配：增加日期字段判断（pfMain.Name = "日期"），仅同步日期筛选，避免影响其他页字段
• 优化代码结构：清理冗余赋值，简化单选/多选分支逻辑，提升代码可维护性

内容的提问来源于stack exchange，提问作者Jack69420