web-dev-qa-db-fra.com

Filtrer le tableau croisé dynamique Excel à l'aide de VBA

J'ai essayé de copier et coller des solutions depuis Internet pour toujours pour essayer de filtrer un tableau croisé dynamique dans Excel à l'aide de VBA. Le code ci-dessous ne fonctionne pas.

Sub FilterPivotTable()
    Application.ScreenUpdating = False
    ActiveSheet.PivotTables("PivotTable2").ManualUpdate = True
    ActiveSheet.PivotTables("PivotTable2").PivotFields("SavedFamilyCode").CurrentPage = "K123223"
    ActiveSheet.PivotTables("PivotTable2").ManualUpdate = False
    Application.ScreenUpdating = True
End Sub

Je veux filtrer donc je vois toutes les lignes qui ont SavedFamilyCode K123223. Je ne veux pas voir d'autres lignes dans le tableau croisé dynamique. Je veux que cela fonctionne indépendamment des filtres précédents. J'espère que vous pourrez m'aider avec ça. Merci!

Sur la base de votre message, j'essaie:

Sub FilterPivotField()
    Dim Field As PivotField
    Field = ActiveSheet.PivotTables("PivotTable2").PivotFields("SavedFamilyCode")
    Value = Range("$A$2")
    Application.ScreenUpdating = False
    With Field
        If .Orientation = xlPageField Then
            .CurrentPage = Value
        ElseIf .Orientation = xlRowField Or .Orientation = xlColumnField Then
            Dim i As Long
            On Error Resume Next ' Needed to avoid getting errors when manipulating fields that were deleted from the data source.
            ' Set first item to Visible to avoid getting no visible items while working
            .PivotItems(1).Visible = True
            For i = 2 To Field.PivotItems.Count
                If .PivotItems(i).Name = Value Then _
                    .PivotItems(i).Visible = True Else _
                    .PivotItems(i).Visible = False
            Next i
            If .PivotItems(1).Name = Value Then _
                .PivotItems(1).Visible = True Else _
                .PivotItems(1).Visible = False
        End If
    End With
    Application.ScreenUpdating = True
End Sub

Malheureusement, j'obtiens l'erreur d'exécution 91: variable d'objet ou avec variable de bloc non définie. Quelle est la cause de cette erreur?

excel-vbafilterpivot-tablevbaexcel
8
user1283776

Field.CurrentPage ne fonctionne que pour les champs de filtre (également appelés champs de page).
Si vous souhaitez filtrer un champ de ligne/colonne, vous devez parcourir les éléments individuels, comme suit:

Sub FilterPivotField(Field As PivotField, Value)
    Application.ScreenUpdating = False
    With Field
        If .Orientation = xlPageField Then
            .CurrentPage = Value
        ElseIf .Orientation = xlRowField Or .Orientation = xlColumnField Then
            Dim i As Long
            On Error Resume Next ' Needed to avoid getting errors when manipulating PivotItems that were deleted from the data source.
            ' Set first item to Visible to avoid getting no visible items while working
            .PivotItems(1).Visible = True
            For i = 2 To Field.PivotItems.Count
                If .PivotItems(i).Name = Value Then _
                    .PivotItems(i).Visible = True Else _
                    .PivotItems(i).Visible = False
            Next i
            If .PivotItems(1).Name = Value Then _
                .PivotItems(1).Visible = True Else _
                .PivotItems(1).Visible = False
        End If
    End With
    Application.ScreenUpdating = True
End Sub

Ensuite, vous appelleriez simplement:

FilterPivotField ActiveSheet.PivotTables("PivotTable2").PivotFields("SavedFamilyCode"), "K123223"

Naturellement, cela devient plus lent plus il y a de différents éléments sur le terrain. Vous pouvez également utiliser SourceName au lieu de Name si cela convient mieux à vos besoins.

8
savyuk

Configurez le tableau croisé dynamique pour qu'il ressemble à ceci:

enter image description here

Votre code peut simplement fonctionner sur la plage ("B1") maintenant et le tableau croisé dynamique sera filtré pour vous nécessaire SavedFamilyCode

Sub FilterPivotTable()
Application.ScreenUpdating = False
    ActiveSheet.Range("B1") = "K123224"
Application.ScreenUpdating = True
End Sub
5
whytheq

Vous pouvez vérifier cela si vous le souhaitez. :)

tilisez ce code si SavedFamilyCode est dans le filtre de rapport:

 Sub FilterPivotTable()
   Application.ScreenUpdating = False
   ActiveSheet.PivotTables("PivotTable2").ManualUpdate = True

   ActiveSheet.PivotTables("PivotTable2").PivotFields("SavedFamilyCode").ClearAllFilters

   ActiveSheet.PivotTables("PivotTable2").PivotFields("SavedFamilyCode").CurrentPage = _
      "K123223"

  ActiveSheet.PivotTables("PivotTable2").ManualUpdate = False
  Application.ScreenUpdating = True
  End Sub

Mais si le SavedFamilyCode est dans les étiquettes de colonne ou de ligne, utilisez ce code:

 Sub FilterPivotTable()
     Application.ScreenUpdating = False
     ActiveSheet.PivotTables("PivotTable2").ManualUpdate = True

      ActiveSheet.PivotTables("PivotTable2").PivotFields("SavedFamilyCode").ClearAllFilters

      ActiveSheet.PivotTables("PivotTable2").PivotFields("SavedFamilyCode").PivotFilters. _
    Add Type:=xlCaptionEquals, Value1:="K123223"

  ActiveSheet.PivotTables("PivotTable2").ManualUpdate = False
  Application.ScreenUpdating = True
  End Sub

J'espère que cela vous aidera.

2
MAF

Les dernières versions d'Excel ont un nouvel outil appelé Slicers. L'utilisation de segments dans VBA est en fait plus fiable que .CurrentPage (il y a eu des rapports de bogues lors de la boucle de nombreuses options de filtre). Voici un exemple simple de la façon dont vous pouvez sélectionner un élément de tranche (n'oubliez pas de désélectionner toutes les valeurs de tranche non pertinentes):

Sub Step_Thru_SlicerItems2()
Dim slItem As SlicerItem
Dim i As Long
Dim searchName as string

Application.ScreenUpdating = False
searchName="Value1"

    For Each slItem In .VisibleSlicerItems
        If slItem.Name <> .SlicerItems(1).Name Then _
            slItem.Selected = False
        Else
            slItem.Selected = True
        End if
    Next slItem
End Sub

Il existe également des services comme SmartKato qui vous aideraient à configurer vos tableaux de bord ou rapports et/ou à corriger votre code.

1
user3357094

Dans Excel 2007, vous pouvez utiliser le code beaucoup plus simple comme suit:

dim pvt as PivotTable
dim pvtField as PivotField

set pvt = ActiveSheet.PivotTables("PivotTable2")
set pvtField = pvt.PivotFiles("SavedFamilyCode")

pvtField.PivotFilters.Add xlCaptionEquals, Value1:= "K123223"
1
ghostJago

Je pense que je comprends votre question. Cela filtre les éléments qui se trouvent dans les étiquettes de colonne ou les étiquettes de ligne. Les 2 dernières sections du code sont ce que vous voulez, mais je colle tout pour que vous puissiez voir exactement comment cela fonctionne du début à la fin avec tout ce qui est défini, etc. J'ai définitivement pris une partie de ce code sur d'autres sites fyi.

Vers la fin du code, le "WardClinic_Category" est une colonne de mes données et dans l'étiquette de colonne du tableau croisé dynamique. Idem pour l'IVUDDCIndicator (c'est une colonne dans mes données mais dans l'étiquette de ligne du tableau croisé dynamique).

J'espère que cela aide les autres ... j'ai trouvé très difficile de trouver du code qui a fait cela de la "bonne manière" plutôt que d'utiliser un code similaire à l'enregistreur de macros.

Sub CreatingPivotTableNewData()


'Creating pivot table
Dim PvtTbl As PivotTable
Dim wsData As Worksheet
Dim rngData As Range
Dim PvtTblCache As PivotCache
Dim wsPvtTbl As Worksheet
Dim pvtFld As PivotField

'determine the worksheet which contains the source data
Set wsData = Worksheets("Raw_Data")

'determine the worksheet where the new PivotTable will be created
Set wsPvtTbl = Worksheets("3N3E")

'delete all existing Pivot Tables in the worksheet
'in the TableRange1 property, page fields are excluded; to select the entire PivotTable report, including the page fields, use the TableRange2 property.
For Each PvtTbl In wsPvtTbl.PivotTables
If MsgBox("Delete existing PivotTable!", vbYesNo) = vbYes Then
PvtTbl.TableRange2.Clear
End If
Next PvtTbl


'A Pivot Cache represents the memory cache for a PivotTable report. Each Pivot Table report has one cache only. Create a new PivotTable cache, and then create a new PivotTable report based on the cache.

'set source data range:
Worksheets("Raw_Data").Activate
Set rngData = wsData.Range(Range("A1"), Range("H1").End(xlDown))


'Creates Pivot Cache and PivotTable:
Worksheets("Raw_Data").Activate
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=rngData.Address, Version:=xlPivotTableVersion12).CreatePivotTable TableDestination:=wsPvtTbl.Range("A1"), TableName:="PivotTable1", DefaultVersion:=xlPivotTableVersion12
Set PvtTbl = wsPvtTbl.PivotTables("PivotTable1")

'Default value of ManualUpdate property is False so a PivotTable report is recalculated automatically on each change.
'Turn this off (turn to true) to speed up code.
PvtTbl.ManualUpdate = True


'Adds row and columns for pivot table
PvtTbl.AddFields RowFields:="VerifyHr", ColumnFields:=Array("WardClinic_Category", "IVUDDCIndicator")

'Add item to the Report Filter
PvtTbl.PivotFields("DayOfWeek").Orientation = xlPageField


'set data field - specifically change orientation to a data field and set its function property:
With PvtTbl.PivotFields("TotalVerified")
.Orientation = xlDataField
.Function = xlAverage
.NumberFormat = "0.0"
.Position = 1
End With

'Removes details in the pivot table for each item
Worksheets("3N3E").PivotTables("PivotTable1").PivotFields("WardClinic_Category").ShowDetail = False

'Removes pivot items from pivot table except those cases defined below (by looping through)
For Each PivotItem In PvtTbl.PivotFields("WardClinic_Category").PivotItems
    Select Case PivotItem.Name
        Case "3N3E"
            PivotItem.Visible = True
        Case Else
            PivotItem.Visible = False
        End Select
    Next PivotItem


'Removes pivot items from pivot table except those cases defined below (by looping through)
For Each PivotItem In PvtTbl.PivotFields("IVUDDCIndicator").PivotItems
    Select Case PivotItem.Name
        Case "UD", "IV"
            PivotItem.Visible = True
        Case Else
            PivotItem.Visible = False
        End Select
    Next PivotItem

'turn on automatic update / calculation in the Pivot Table
PvtTbl.ManualUpdate = False


End Sub
1
Brettvenker