VBA批量筛选同数据源数据透视表日期时触发Run-time error '1004'问题求助

Let’s break down why you’re hitting that 1004 error on 5 out of 6 pivot tables, and fix it step by step.

Common Causes of the Error #

From looking at your code and the behavior you described, here are the most likely issues:

• Missing or misnamed field in pivot tables: Even though all pivot tables use the same data source, it’s possible that the Date d'insertion field isn’t added to the layout of the problematic pivot tables, or the field name has a subtle discrepancy (like extra spaces, accented character mismatches, or a rename in the pivot table itself). If the field isn’t part of the pivot table’s visible structure, trying to filter it throws a 1004 error.
• Uncleared existing filters: Your first pivot table uses ClearAllFilters before applying new filters, but the other 5 don’t. If those pivot tables already have a filter on Date d'insertion, adding a new filter without clearing the old one can cause a conflict.
• Date format mismatch: You’re pulling date values as text with .Text, which depends on the cell’s display format. If the pivot table’s Date d'insertion field stores dates as actual date values (not text), passing text strings might cause Excel to fail parsing the date range.

Fixes to Implement #

Let’s adjust your code and verify the pivot table setup to resolve the error:

1. Verify Pivot Table Field Setup First #

Before modifying code, manually check each problematic pivot table:

• Open the pivot table field list for Protection, IGtraité, PIMOF, IGencours, and IGouvert.
• Confirm that Date d'insertion is present in the list, and that it’s added to either the Filters, Rows, Columns, or Values area (it needs to be part of the pivot table’s layout to be filterable).
• Double-check the field name matches exactly Date d'insertion (no typos, extra spaces, or renamed labels).

2. Revised VBA Code #

Here’s an updated version of your code that addresses all three issues, plus makes the code more reliable by avoiding unnecessary Activate/Select calls:

Sub filter()
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim Datainicial As String
    Dim Datafinal As String
    Dim dtStart As Date, dtEnd As Date
    
    ' Use direct object references instead of activating (more stable)
    Set wb = Workbooks("SAFE.xlsm")
    Set ws = wb.Sheets("Dinamic")
    
    ' Get date values
    Datainicial = ws.Range("A2").Text
    Datafinal = ws.Range("C2").Text
    
    ' Validate input
    If Datainicial = "" Or Datafinal = "" Then
        MsgBox "Veuillez sélectionner la période souhaitée pour l'analyse.", vbCritical, "Date d'insertion"
        Exit Sub
    End If
    
    ' Convert text to actual date values to avoid format issues
    On Error Resume Next
    dtStart = CDate(Datainicial)
    dtEnd = CDate(Datafinal)
    If Err.Number <> 0 Then
        MsgBox "Les dates saisies ne sont pas valides.", vbCritical, "Erreur Date"
        Exit Sub
    End If
    On Error GoTo 0
    
    ' Declare pivot table variables
    Dim Tabela1 As PivotTable
    Dim Tabela2 As PivotTable
    Dim Tabela3 As PivotTable
    Dim Tabela4 As PivotTable
    Dim Tabela5 As PivotTable
    Dim Tabela6 As PivotTable
    
    Set Tabela1 = ws.PivotTables("Dist")
    Set Tabela2 = ws.PivotTables("Protection")
    Set Tabela3 = ws.PivotTables("IGtraité")
    Set Tabela4 = ws.PivotTables("PIMOF")
    Set Tabela5 = ws.PivotTables("IGencours")
    Set Tabela6 = ws.PivotTables("IGouvert")
    
    ' --- Tabela1 - Distribuição afetação TOP 5 ---
    Tabela1.ClearAllFilters
    Tabela1.PivotFields("Code NITG").PivotFilters.Add Type:=xlCaptionDoesNotContain, Value1:="(em branco)"
    Tabela1.PivotFields("Dernière source intégrée").PivotFilters.Add Type:=xlCaptionEquals, Value1:="DRG"
    
    ' Remove unnecessary Select call
    Tabela1.PivotFields("Libellé NITG").AutoSort _
        xlDescending, "Quantité", Tabela1.PivotColumnAxis.PivotLines(1), 1
    
    Tabela1.PivotFields("Code NITG").ClearAllFilters
    Tabela1.PivotFields("Code NITG").PivotFilters.Add2 _
        Type:=xlTopCount, DataField:=Tabela1.PivotFields("Quantité"), Value1:=5
    
    ' Apply date filter with actual date values
    ApplyDateFilter Tabela1, "Date d'insertion", dtStart, dtEnd
    
    ' --- Process remaining pivot tables ---
    ApplyDateFilter Tabela2, "Date d'insertion", dtStart, dtEnd
    ApplyDateFilter Tabela3, "Date d'insertion", dtStart, dtEnd
    ApplyDateFilter Tabela4, "Date d'insertion", dtStart, dtEnd
    ApplyDateFilter Tabela5, "Date d'insertion", dtStart, dtEnd
    ApplyDateFilter Tabela6, "Date d'insertion", dtStart, dtEnd
    
    MsgBox "Période d'analyse souhaitée définie."
End Sub

' Helper sub to safely apply date filters to pivot tables
Sub ApplyDateFilter(pvt As PivotTable, fieldName As String, startDate As Date, endDate As Date)
    Dim pf As PivotField
    On Error Resume Next
    Set pf = pvt.PivotFields(fieldName)
    On Error GoTo 0
    
    If Not pf Is Nothing Then
        pvt.ClearAllFilters ' Clear existing filters first
        pf.PivotFilters.Add Type:=xlDateBetween, Value1:=startDate, Value2:=endDate
    Else
        MsgBox "Le champ '" & fieldName & "' n'existe pas dans le tableau croisé dynamique '" & pvt.Name & "'", vbExclamation, "Champ Manquant"
    End If
End Sub

Key Improvements in the Revised Code: #

• Direct object references: No more Activate/Select calls, which are a common source of 1004 errors in VBA.
• Date validation & conversion: Converts text dates to actual Date values, ensuring Excel recognizes the range correctly.
• Centralized filter logic: The ApplyDateFilter helper sub reduces code duplication and adds error checking for missing fields.
• Clear filters first: Every pivot table gets ClearAllFilters before applying the new date filter, preventing conflicts with existing filters.

Additional Troubleshooting Tip #

If you still get errors after implementing the above, check if the pivot tables are set to Manual Update. If they are, add pvt.RefreshTable before applying filters in the ApplyDateFilter sub to ensure the pivot table has the latest data.

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