Note: The other languages of the website are Google-translated. Back to English
Se connecter  \/ 
x
or
x
S'inscrire  \/ 
x

or

Comment filtrer le tableau croisé dynamique en fonction d'une valeur de cellule spécifique dans Excel?

Normalement, nous filtrons les données dans un tableau croisé dynamique en vérifiant les valeurs de la liste déroulante comme illustré sur la capture d'écran de gauche. Si vous souhaitez rendre un tableau croisé dynamique plus dynamique en filtrant, vous pouvez essayer de le filtrer en fonction de la valeur d'une cellule spécifique. La méthode VBA de cet article vous aidera à résoudre le problème.

Normalement, nous filtrons les données dans un tableau croisé dynamique en vérifiant les valeurs de la liste déroulante comme illustré sur la capture d'écran de gauche. Si vous souhaitez rendre un tableau croisé dynamique plus dynamique en filtrant, vous pouvez essayer de le filtrer en fonction de la valeur d'une cellule spécifique. La méthode VBA de cet article vous aidera à résoudre le problème.

Filtrer le tableau croisé dynamique en fonction d'une valeur de cellule spécifique avec le code VBA

Filtrer le tableau croisé dynamique en fonction d'une valeur de cellule spécifique avec le code VBA

Le code VBA suivant peut vous aider à filtrer un tableau croisé dynamique en fonction d'une valeur de cellule spécifique dans Excel. Veuillez faire comme suit.

1. Veuillez entrer une valeur sur laquelle vous filtrerez le tableau croisé dynamique dans une cellule à l'avance (ici, je sélectionne la cellule H6).

2. Ouvrez la feuille de calcul contient le tableau croisé dynamique que vous filtrerez par valeur de cellule. Cliquez ensuite avec le bouton droit sur l'onglet de la feuille et sélectionnez Afficher le code dans le menu contextuel. Voir la capture d'écran:

3. Dans l'ouverture Microsoft Visual Basic pour applications fenêtre, copiez ci-dessous le code VBA dans la fenêtre Code.

Code VBA: filtre de tableau croisé dynamique basé sur la valeur de la cellule

Private Sub Worksheet_Change(ByVal Target As Range)
'Update by Extendoffice 20180702
    Dim xPTable As PivotTable
    Dim xPFile As PivotField
    Dim xStr As String
    On Error Resume Next
    If Intersect(Target, Range("H6:H7")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Set xPTable = Worksheets("Sheet1").PivotTables("PivotTable2")
    Set xPFile = xPTable.PivotFields("Category")
    xStr = Target.Text
    xPFile.ClearAllFilters
    xPFile.CurrentPage = xStr
    Application.ScreenUpdating = True
End Sub

Notes: Dans le code,

1) "Sheet1»Est le nom de la feuille de calcul.
2) "Tableau croisé dynamique2»Est le nom du tableau croisé dynamique.
3) Le champ de filtrage dans le tableau croisé dynamique s'appelle "Catégories".
4) La valeur que vous souhaitez filtrer dans le tableau croisé dynamique est placée dans la cellule H6.
Vous pouvez modifier les valeurs des variables ci-dessus selon vos besoins.

4. appuie sur le autre + Q touches pour fermer le Microsoft Visual Basic pour applications fenêtre.

Ensuite, le tableau croisé dynamique filtre en fonction de la valeur de la cellule H6, comme illustré ci-dessous:

Vous pouvez changer la valeur de la cellule en d'autres selon vos besoins.

Notes: Les valeurs que vous saisissez dans la cellule H6 doivent correspondre exactement aux valeurs de la liste déroulante Catégorie du tableau croisé dynamique.

Articles Liés:

Les meilleurs outils de productivité de bureau

Kutools for Excel résout la plupart de vos problèmes et augmente votre productivité de 80%

  • Réutilisation: Insérer rapidement formules complexes, graphiques et tout ce que vous avez utilisé auparavant; Crypter les cellules avec mot de passe; Créer une liste de diffusion et envoyer des e-mails ...
  • Barre Super Formula (modifiez facilement plusieurs lignes de texte et de formule); Disposition de lecture (lire et modifier facilement un grand nombre de cellules); Coller dans la plage filtrée...
  • Fusionner les cellules / lignes / colonnes sans perdre de données; Contenu des cellules divisées; Combiner des lignes / colonnes en double... Empêcher les cellules en double; Comparer les gammes...
  • Sélectionnez Dupliquer ou Unique Lignes; Sélectionnez les lignes vides (toutes les cellules sont vides); Super Find et Fuzzy Find dans de nombreux classeurs; Sélection aléatoire ...
  • Copie exacte Plusieurs cellules sans changer la référence de formule; Créer automatiquement des références à plusieurs feuilles; Insérer des puces, Cases à cocher et plus encore ...
  • Extrait du texte, Ajouter du texte, Supprimer par position, Supprimer l'espace; Créer et imprimer des sous-totaux de pagination; Conversion entre le contenu et les commentaires des cellules...
  • Super filtre (enregistrer et appliquer des schémas de filtrage à d'autres feuilles); Tri avancé par mois / semaine / jour, fréquence et plus; Filtre spécial par gras, italique ...
  • Combiner des classeurs et des feuilles de travail; Fusionner les tableaux en fonction des colonnes clés; Diviser les données en plusieurs feuilles; Conversion par lots xls, xlsx et PDF...
  • Plus de 300 fonctionnalités puissantes. Prend en charge Office / Excel 2007-2019 et 365. Prend en charge toutes les langues. Déploiement facile dans votre entreprise ou organisation. Essai gratuit de 30 jours. Garantie de remboursement de 60 jours.
onglet kte 201905

Office Tab apporte une interface à onglets à Office et simplifie considérablement votre travail

  • Activer l'édition et la lecture par onglets dans Word, Excel, PowerPoint, Publisher, Access, Visio et Project.
  • Ouvrez et créez plusieurs documents dans de nouveaux onglets de la même fenêtre, plutôt que dans de nouvelles fenêtres.
  • Augmente votre productivité de 50% et réduit des centaines de clics de souris chaque jour!
bas de cabine
Say something here...
symbols left.
You are guest
or post as a guest, but your post won't be published automatically.
Loading comment... The comment will be refreshed after 00:00.
  • To post as a guest, your comment is unpublished.
    Oksana · 6 months ago
    What if i want to link the selection cell to a different tab? This is my code so far

    Private Sub Worksheet_Change(ByVal Target As Range)
    Dim xPTable1 As PivotTable
    Dim xPFile1 As PivotField
    Dim xStr1 As String
    On Error Resume Next
    If Intersect(Target, Range("B1")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Set xPTable1 = Worksheets("SM_SKU PIVOTS").PivotTables("PivotTable1")
    Set xPFile1 = xPTable1.PivotFields("Geography")
    xStr1 = Target.Text
    xPFile1.ClearAllFilters
    xPFile1.CurrentPage = xStr1
    Application.ScreenUpdating = True

    Dim xPTable2 As PivotTable
    Dim xPFile2 As PivotField
    Dim xStr2 As String
    On Error Resume Next
    If Intersect(Target, Range("B1")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Set xPTable2 = Worksheets("SM_SKU PIVOTS").PivotTables("PivotTable4")
    Set xPFile2 = xPTable2.PivotFields("Geography")
    xStr2 = Target.Text
    xPFile2.ClearAllFilters
    xPFile2.CurrentPage = xStr2
    Application.ScreenUpdating = True

    Dim xPTable3 As PivotTable
    Dim xPFile3 As PivotField
    Dim xStr3 As String
    On Error Resume Next
    If Intersect(Target, Range("B1")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Set xPTable3 = Worksheets("SM_SKU PIVOTS").PivotTables("PivotTable8")
    Set xPFile3 = xPTable3.PivotFields("Geography")
    xStr3 = Target.Text
    xPFile3.ClearAllFilters
    xPFile3.CurrentPage = xStr3
    Application.ScreenUpdating = True

    End Sub
  • To post as a guest, your comment is unpublished.
    Fernando · 10 months ago
    Olá, gostaria de saber se quisesse filtrar mais de uma categoria como poderia ser?

  • To post as a guest, your comment is unpublished.
    sdas34 · 1 years ago
    I would like to use multiple Worksheet Change code in same worksheet. How to do that? My code is as below:

    Private Sub Worksheet_Change(ByVal Target As Range)
    'Pivot table filter based on cell value
    Dim xPTable As PivotTable
    Dim xPFile As PivotField
    Dim xStr As String
    On Error Resume Next
    If Intersect(Target, Range("D20:D21")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Set xPTable = Worksheets("Sheet1").PivotTables("PivotTable2")
    Set xPFile = xPTable.PivotFields("Designation")
    xStr = Target.Text
    xPFile.ClearAllFilters
    xPFile.CurrentPage = xStr
    Application.ScreenUpdating = True
    End Sub

    Private Sub Worksheet_Change2(ByVal Target As Range)
    'Pivot table filter based on cell value 2
    Dim xPTable As PivotTable
    Dim xPFile As PivotField
    Dim xStr As String
    On Error Resume Next
    If Intersect(Target, Range("H20:H21")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Set xPTable = Worksheets("Sheet1").PivotTables("PivotTable2")
    Set xPFile = xPTable.PivotFields("Offering")
    xStr = Target.Text
    xPFile.ClearAllFilters
    xPFile.CurrentPage = xStr
    Application.ScreenUpdating = True
    End Sub
  • To post as a guest, your comment is unpublished.
    Drew · 1 years ago
    Is this possible with google sheets? If so, how?
    • To post as a guest, your comment is unpublished.
      Vibhor · 4 months ago
      Google Sheets will not require any pivot table. you can directly perform through Filter Function
  • To post as a guest, your comment is unpublished.
    AKTaylor · 1 years ago
    I was able to modify/filter 3 different pivots which are on the same tab. I also added a row in my data set "No Data Found", otherwise it left the filter to "ALL" which I didn't want. The above was a great help to earn me Kudos with management so I wanted to share. Note the (All) is case sensitive took me a bit to figure that out.

    Private Sub Worksheet_Change(ByVal Target As Range)
    'test
    Dim xPTable As PivotTable
    Dim xPFile As PivotField
    Dim xStr As String

    Dim x2PTable As PivotTable
    Dim x2PFile As PivotField
    Dim x2Str As String

    Dim x3PTable As PivotTable
    Dim x3PFile As PivotField
    Dim x3Str As String

    On Error Resume Next
    If Intersect(Target, Range("a2:e2")) Is Nothing Then Exit Sub

    Application.ScreenUpdating = False

    'tbl-1
    Set xPTable = Worksheets("Graphical").PivotTables("PivotTable1")
    Set xPFile = xPTable.PivotFields("MR Department - Department")
    xStr = Target.Text
    xPFile.ClearAllFilters
    xPFile.CurrentPage = xStr
    If xPFile.CurrentPage = "(All)" Then xPFile.CurrentPage = "No Data Found"

    'tbl-2
    Set x2PTable = Worksheets("Graphical").PivotTables("PivotTable2")
    Set x2PFile = x2PTable.PivotFields("MR Department - Department")
    x2Str = Target.Text
    x2PFile.ClearAllFilters
    x2PFile.CurrentPage = x2Str
    If x2PFile.CurrentPage = "(All)" Then x2PFile.CurrentPage = "No Data Found"

    'tbl-3
    Set x3PTable = Worksheets("Graphical").PivotTables("PivotTable3")
    Set x3PFile = x3PTable.PivotFields("MR Department - Department")
    x3Str = Target.Text
    x3PFile.ClearAllFilters
    x3PFile.CurrentPage = x3Str
    If x3PFile.CurrentPage = "(All)" Then x3PFile.CurrentPage = "No Data Found"

    Application.ScreenUpdating = True

    End Sub
  • To post as a guest, your comment is unpublished.
    Heather · 1 years ago
    Hi, I can't seem to get this to work. The cell I want to refer to is pulled in through from a formula - would this be why the filter can't find it as it is looking at the formula rather than the value that the formula returns?
    Thanks in advance
    Heather McDonagh
    • To post as a guest, your comment is unpublished.
      Sabrina · 2 months ago
      Hi Heather, did you find a solution. I have just the same problem.
  • To post as a guest, your comment is unpublished.
    Aravind · 1 years ago
    Hello for some reason, this macro after entering into the visual basic page, does not show up at all. I am unable to enable/run this macro, i have checked all the trust center setting, but nothing happens, please help me
  • To post as a guest, your comment is unpublished.
    Ignacia · 2 years ago
    Hey! Thanks for your macro.

    I was trying to use it for more than one pivot table in the same page, but it does not work. I wrote it like this:

    Private Sub Worksheet_Change(ByVal Target As Range)
    Dim xPTable1 As PivotTable
    Dim xPFile1 As PivotField
    Dim xStr1 As String
    On Error Resume Next
    If Intersect(Target, Range("D7")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Set xPTable1 = Worksheets("BUSCADOR").PivotTables("PV_ETAPA1")
    Set xPFile1 = xPTable1.PivotFields("ETAPA1")
    xStr1 = Target.Text
    xPFile1.ClearAllFilters
    xPFile1.CurrentPage = xStr1
    Application.ScreenUpdating = True

    Dim xPTable2 As PivotTable
    Dim xPFile2 As PivotField
    Dim xStr2 As String
    On Error Resume Next
    If Intersect(Target, Range("G7")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Set xPTable2 = Worksheets("BUSCADOR").PivotTables("PV_ETAPA2")
    Set xPFile2 = xPTable2.PivotFields("ETAPA2")
    xStr2 = Target.Text
    xPFile2.ClearAllFilters
    xPFile2.CurrentPage = xStr2
    Application.ScreenUpdating = True

    End Sub

    Maybe you can help me out!

    Thanks in advance!
    • To post as a guest, your comment is unpublished.
      michael · 1 years ago
      Hi


      thanks for the Macro


      I am Trying the same thing but cannot get it to work on 2 tables. they are both looking at the same cell just 2 different pivot tables


      thanks
      • To post as a guest, your comment is unpublished.
        Oksana · 6 months ago
        You have to change the Pivot Table name. Each pivot table has a different name. to get that, right click on the pivot and select pivot table settings, the name will be at the top 
  • To post as a guest, your comment is unpublished.
    Justin · 3 years ago
    How would you do this with a report filter that has a hierarchy?

  • To post as a guest, your comment is unpublished.
    Daniel · 3 years ago
    Using this code (updated for my variables of course), when changing the field, the filter changes momentarily to the correct one, and then clears itself almost immediately. Trying to figure out why it's doing this (wondering if it has something to do with the ClearAllFilters at the end of the sub?)