Filtre TCD valeur de plusieurs cellules

Bonjour à tous,

Je me permet de poster ici pour demander un peu d'aide, puisque j'ai un petit soucis sur VBA avec le traitement d'un TCD.

Voilà le problème : j'aimerai filtrer 5 valeurs pour une étiquette de colonne nommée "Date de fin", qui correspondent à des dates contenues dans les cellules E3, F3, G3, H3, I3 de la feuille "Charge".

J'ai testé le code ci-dessous qui fonctionne pour la première date (en E3). Cependant il m'annonce une erreur pour les suivantes.

ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields("Date de fin").EnableMultiplePageItems = True

    With ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields( _
        "Date de fin")

 .PivotItems(Sheets("Charge").Range("E3").Value).Visible = True

    End With

J'ai fais quelques recherches et n'ai pas trouvé la possibilité de modifier un filtre avec plusieurs cellules.

J'espère que ma demande est assez claire et précise.

Je vous remercie de votre aide et vous souhaite une bonne soirée !

Bonjour,

Une proposition à étudier.

Cdlt.

Bonjour Jean-Eric,

Tout d'abord je te remercie pour ton aide.

J'ai essayé d'adapter ton code mais il me donne plusieurs erreurs. Pour simplifier les choses, je joins un fichier allégé en pièce-jointe.

Je te remercie,

Victo

Bonjour,

Une nouvelle proposition à étudier et à tester.

Cdlt.

J'ai testé ton code et il me donne une erreur. Avec le mode pas à pas, il semblerait que cela vient de la partie en jaune ci-dessous :

For Each pi In pf.PivotItems
        x = CStr(pi.Name)
        Set rCell = [s.range].Find _
                    (what:=x, _
                     LookIn:=xlValues, _
                     lookat:=xlWhole)
        If rCell Is Nothing Then pi.Visible = False
    Next pi

Re,

Modifie ainsi :

Option Explicit

Private Sub Worksheet_Activate()
Dim rCell As Range
Dim pt As PivotTable
Dim pf As PivotField
Dim pi As PivotItem
Dim x As String

    Application.ScreenUpdating = False
    '------------------------------------------------------
    Set pt = Me.PivotTables(1)
    Set pf = pt.PivotFields("Date de fin")
    '------------------------------------------------------
    With pt
        .ManualUpdate = True
        .PivotCache.MissingItemsLimit = xlMissingItemsNone
        .RefreshTable
    End With
    '------------------------------------------------------
    pf.ClearAllFilters
    '------------------------------------------------------
    For Each pi In pf.PivotItems
        x = CStr(pi.Name)
        Set rCell = [s.range].Find _
                    (what:=x, _
                     LookIn:=xlValues, _
                     lookat:=xlWhole)
       On Error Resume Next
        If rCell Is Nothing Then pi.Visible = False
       On Error GoTo 0
    Next pi
    '------------------------------------------------------
    Application.ScreenUpdating = True
    pt.ManualUpdate = False
    '------------------------------------------------------
    Set rCell = Nothing
    Set pf = Nothing: Set pt = Nothing

End Sub

Cette solution semble marcher !

Cependant il y a un petit détail : le code me sélectionne les 5 dates demandées dans le tableau mais il sélectionne aussi toutes les autres dates présentes dans la base de données.. En gros on dirait que le pf.ClearAllFilters ne fonctionne pas..

Je préfèrerais qu'il n'affiche dans le TCD que les données pour les 5 dates demandées.

(Ci-joint le fichier pour que tu puisse t'en rendre compte)

RE,

Je ne comprends pas ton souci.

Bonjour,

Ce que je voulais dire c'est que si par exemple dans l'onglet extraction il y a une référence avec des quantités au 19/12/2016, alors elle va être affichée dans le TCD. Cependant il faudrait que seules les dates demandées sur la page charge (ici du 12 au 16/12/2016) soient cochées dans le filtre "Date de fin" et donc affichées dans le TCD.

Bonjour,

Je ne comprends pas tout.

Le même fichier avec un nouvel exemple de dates..

Le filtre est actif et conforme à la demande.

Cdlt.

Bonjour,

ne fonctionne pas en 2007-2010 mais bien en 2016, Jean-Eric

Perso , je ne fais jamais de vba sur les tcd, donc je ne sais pas aider pour le moment et là je dois m'absenter.

P.

Re,

Je ne pourrai pas regarder ce week-end.

La procédure ne comporte pas d'éléments particuliers à Excel 2016.

Le souci est donc sur l'interprétation de la date avec 2007 et 2010.

Je verrai dans mes archives comment je faisais avant...

Bon week-end à toutes et tous.

Cdlt.

Je viens de tester sur mon PC personnel et il semblerait que ça fonctionne. Je vérifierai lundi et validerai le sujet à ce moment

Denier détail, les données de l'onglet "Extraction" se mettent à jour à chaque ouverture du fichier, et il peut y avoir des dates et qtés qui viennent se rajouter.

J'ai vu en rajoutant des lignes manuellement que dans le TCD les dates ne s'affichaient pas dans l'ordre croissant (cf screen ci-dessous). Est-ce que tu sais s'il serais possible d'y remédier ?

Je te remercie grandement de ton aide

Bonjour,

J'ai ajouté le tri dans la procédure.

Pour ton souci de dates, je n'oublie pas.

Cdlt.

Option Explicit

Private Sub Worksheet_Activate()
' Déclaration des variables
Dim rCell As Range
Dim pt As PivotTable
Dim pf As PivotField
Dim pi As PivotItem
Dim x As String
    ' Optimisation procédure (gel affichage)
    Application.ScreenUpdating = False
    '------------------------------------------------------
    ' Initialisation des variables
    Set pt = Me.PivotTables(1)
    Set pf = pt.PivotFields("Date de fin")
    '------------------------------------------------------
    With pt
        ' Calcul manuel
        .ManualUpdate = True
        ' Eléments uniques conservés
        .PivotCache.MissingItemsLimit = xlMissingItemsNone
        ' Acualisation TCD
        .RefreshTable
    End With
    '------------------------------------------------------
    ' Suppression filtres existants
    pf.ClearAllFilters
    '------------------------------------------------------
    ' Filtre sur dates de la plage s.range (E3:I3)
    For Each pi In pf.PivotItems
        x = CStr(pi.Name)
        Set rCell = [s.range].Find _
                    (what:=x, _
                     LookIn:=xlValues, _
                     lookat:=xlWhole)
        On Error Resume Next
        If rCell Is Nothing Then pi.Visible = False
        On Error GoTo 0
    Next pi
    '------------------------------------------------------
    Application.ScreenUpdating = True
    With pt
        ' Tri
        .PivotFields("Date de fin").AutoSort _
                Order:=xlAscending, _
                field:="date de fin"
        ' Calcul
        .ManualUpdate = False
    End With
    '------------------------------------------------------
    ' RAZ variables
    Set rCell = Nothing
    Set pf = Nothing: Set pt = Nothing

End Sub

Bonjour Jean-Eric,

Je viens de tester sur mon pc travail et comme l'a dit patrick1957, il semblerait que ça ne fonctionne pas sur Excel 2010 alors que sur mon pc personnel ça marchait très bien

Je ne vois pas trop quelle expression est spécifique à Excel 2010, donc je ne sais pas comment le modifier malheureusement.

Bonne journée

Re,

Ne trouvant pas de solutions, j'ai essayé de tout recommencer différemment.

Alors en me basant sur l'enregistreur de macro (pas très fiable mais bon, ça permet d'avoir une idée de fonctionnement du TCD), j'ai écris le code suivant, qui sur le papier me parait correct :

Private Sub Worksheet_Activate()

Dim Pt As PivotTable
Dim Pf As PivotField
Dim Pi As PivotItem

    Set Pt = Me.PivotTables(1)
    Set Pf = Pt.PivotFields("Date de fin")

        For Each Pi In Pf.PivotItems

            If Pi = Sheets("Charge").Range("E3").Value Or Pi = Sheets("Charge").Range("F3").Value Or Pi = Sheets("Charge").Range("G3").Value Or Pi = Sheets("Charge").Range("H3").Value Or Pi = Sheets("Charge").Range("I3").Value Then
                Pi.Visible = True
            Else
                Pi.Visible = False        
            End If

        Next Pi

End Sub

Cependant j'ai une erreur d'exécution qui apparaît au niveau de ma boucle If, et je ne vois pas forcément pourquoi...

Peut-être saurais-tu m'aider ?

Je te remercie d'avance

Bonjour,

J'ai regardé pour modifier la procédure, mais j'en reviens à la solution initiale.

Je ne comprends pas l'erreur sur pi.Visible=False.

Peux-tu en dire un plus sur l'erreur ?

(en début de boucle, sur quelle valeur de pi, etc...)

Cdlt.

' Filtre sur dates de la plage s.range (E3:I3)
    For Each pi In pf.PivotItems
        x = CStr(pi.Name) ' ou pi.value
        Set rCell = [s.range].Find _
                    (what:=x, _
                     LookIn:=xlValues, _
                     lookat:=xlWhole)
        If rCell Is Nothing Then pi.Visible = False
    Next pi

Bonjour,

En essayant ton code précédent, j'ai également le problème sur la boucle If Rcell = Nothing (voir photo ci-joint).

La valeur de x est "20/12/2016", celle de Rcell est "nothing".

On dirait que quand il ne reconnait pas la date dans le fichier charge il n'arrive pas à la traiter..

Petite mise à jour :

J'ai remarqué que le code marchait très bien dans ma base de données réelle pour une date de fin définie comme "00.00.0000". Je me suis dis que peut-être l'erreur venait des "/" dans la date.

En remplaçant dans ma base de données tous les "/" par des ".", et en le faisant également dans les 5 dates demandées sur la feuille charge, ton code fonctionne vraiment parfaitement (le fichier est en pièce jointe si tu veux voir le résultat) !

Je valide donc le sujet puisque le problème n'a plus lieu d'être.

Je te remercie vraiment énormément pour ton aide ces derniers jours !

Bonjour,

Tu n'as plus de souci car tu ne travailles plus avec des dates.

Ca ne m'explique pas pour quelle raison tu avais cette erreur.

Bonnes fêtes de fin d'année.

Cdlt.