基于单元格引用同步筛选两个Excel数据透视表的VBA代码问题

Here's the corrected VBA code that will properly sync your two pivot tables when cell B3 is updated:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim pt1 As PivotTable
    Dim pt4 As PivotTable
    Dim pf1 As PivotField
    Dim pf4 As PivotField
    Dim filterValue As String
    
    ' Only run if cell B3 is modified
    If Intersect(Target, Me.Range("B3")) Is Nothing Then Exit Sub
    
    ' Disable screen updating and events to prevent recursion
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    On Error GoTo Cleanup ' Handle errors gracefully
    
    ' Set references to both pivot tables and their "SEMANA" fields
    Set pt1 = Me.PivotTables("Tableau croisé dynamique1")
    Set pf1 = pt1.PivotFields("SEMANA")
    
    Set pt4 = Me.PivotTables("Tableau croisé dynamique4")
    Set pf4 = pt4.PivotFields("SEMANA")
    
    filterValue = Target.Value
    
    ' Apply filter to first pivot table
    pf1.ClearAllFilters
    pf1.CurrentPage = filterValue
    
    ' Apply same filter to second pivot table
    pf4.ClearAllFilters
    pf4.CurrentPage = filterValue
    
Cleanup:
    ' Re-enable screen updating and events
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    
    ' Show error message if something went wrong
    If Err.Number <> 0 Then
        MsgBox "Error: " & Err.Description, vbExclamation
    End If
End Sub

Key Fixes from Your Original Code: #

• Typo Correction: You referenced xPTable instead of xPTable4 when setting the pivot field for the second table—this was the primary reason synchronization failed.
• Redundant Variable Removal: Eliminated duplicate xStr4 since both tables use the same filter value from cell B3.
• Structured Error Handling: Replaced On Error Resume Next with a proper error handler that alerts you to issues instead of hiding them.
• Event Disabling: Added Application.EnableEvents = False to prevent the Worksheet_Change event from triggering itself during pivot table updates.
• Robust Worksheet Reference: Used Me (since this code lives in the worksheet module) instead of hardcoding the worksheet name, making the code more reliable.

Additional Notes: #

• Confirm the pivot field name "SEMANA" is identical in both tables (case-sensitive in some Excel versions).
• The value in cell B3 must match an existing item in the "SEMANA" field of both pivot tables—otherwise, the error handler will display a message explaining the issue.

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