Filtrer un TCD avec une variable issue d'Inpubox

Le 02/11/2020 à 12:41

Bonjour à tous,

Malgré mes recherches, je ne trouve pas le code adéquat pour faire ce que je veux.

Je fais une macro qui met à jour des extractions, un TCD mais également qui vient filtrer le TCD en fonction de la valeur rentrée via une Inpubox.

Tout se passe assez bien, sauf que lors du filtre, plusieurs valeurs reste cochées sur le TCD.

A mon avis cela provient du .PivotItems("28/10/2020").Visible = False

Merci beaucoup par avance !

Sub MAJ()
'
' MAJ Macro
' Met à jour les extracs + TCD
'

'
    Dim E As Object
    Dim a As String
    Set E = Sheets("Priorités J+1")
   a = InputBox("Date OTIF ? JJ/MM/AAAA", "Date OTIF")
    If a <> "" Then
    Sheets("Stocou").Select
    Range("Tableau_Lancer_la_requête_à_partir_de_AS4003[[#Headers],[QTE_PREV]]"). _
        Select
    Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False
    Sheets("Extraction ").Select
    Range("AB14").Select
    Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False
    Sheets("Priorités J+1").Select
     With ActiveSheet.PivotTables("Tableau croisé dynamique6").PivotFields( _
        "dernière date")
        .PivotItems("28/10/2020").Visible = False
        .PivotItems(a).Visible = True
        Range("F5").Select
    ActiveSheet.PivotTables("Tableau croisé dynamique6").PivotCache.Refresh
    End With
    End If
End Sub
Le 02/11/2020 à 13:57

Bonjour

Sans fichier ce n'est jamais simple avec les TCD. MAis essayez comme ceci :

Sub MAJ()
' MAJ Macro
' Met à jour les extracs + TCD
 Dim E As Object
 Dim a As String

Set E = Sheets("Priorités J+1")
a = InputBox("Date OTIF ? JJ/MM/AAAA", "Date OTIF")
If a <> "" Then
    Sheets("Stocou").Range("Tableau_Lancer_la_requête_à_partir_de_AS4003[[#Headers],[QTE_PREV]]").ListObject.QueryTable.Refresh BackgroundQuery:=False
    Sheets("Extraction ").Range("AB14").ListObject.QueryTable.Refresh BackgroundQuery:=False
    With Sheets("Priorités J+1")
        With .PivotTables("Tableau croisé dynamique6").PivotFields("dernière date")
            .ClearAllFilters
            .PivotItems("28/10/2020").Visible = False
            .PivotItems(a).Visible = True
            Range("F5").Select
        End With
        .PivotTables("Tableau croisé dynamique6").PivotCache.Refresh
    End With
End If
End Sub

NB : il y a un espace après le nom Extraction ??

Cordialement

Le 02/11/2020 à 15:02

Bonjour Dan,

Tout d'abord merci de me venir en aide !

J'ai essayé votre code, mais cela ne fonctionne pas, au contraire, cela sélectionne toutes les cases.

Je cherche à filtrer le TCD uniquement sur la valeur rentrée dans l'Inputbox

Le 02/11/2020 à 15:24

Je cherche à filtrer le TCD uniquement sur la valeur rentrée dans l'Inputbox

C'est ce que vous faites à la ligne pivotitems(a)

Vous pouvez enlever cette instruction à mon avis -->

.PivotItems("28/10/2020").Visible = False

Lorsque vous mettez une valeur a, il faut qu'elle soit mentionnée dans le TCD, sans quoi le flltre de peut se faire

Est-ce bien le cas ?

Le 02/11/2020 à 15:59

Dan,

Je viens de supprimer l'instruction mais cela sélectionne quand même toutes les lignes.

Connaissez-vous une ligne de code, pour que toutes les valeurs soient en . Visible = False et qu'on affiche uniquement .PivotItems(a).Visible = True ?

J'ai tenté avec .PivotItems(all).Visible = False mais cela ne marche pas

Le 02/11/2020 à 16:11

C'est ce que je vous ai donné...

Si cela ne fonctionne pas enlever l'instruction Clearallfilters et juste au dessus de la ligne With Sheets("Priorités J+1") mettez ceci

Sheets("Priorités J+1").PivotTables("Tableau croisé dynamique6").ClearAllFilters
Le 02/11/2020 à 16:34

Je viens d'essayer et cela ne va pas non plus, il selctionne toutes les lignes.

Le code ci-dessous de la macro que vous m'avez envoyé et que j'ai modifié avec les dernières corrections, ça se trouve c'est moi qui ai mal mis les lignes.

J'ai également essayé en enlevant la ligne .PivotItems("28/10/2020").Visible = False, mais cela n'a eu aucun effet.

Sub Macro2()
'
' Macro2 Macro - Test Code Dan
' Met à jour les extracs + TCD
 Dim E As Object
 Dim a As String

Set E = Sheets("Priorités J+1")
a = InputBox("Date OTIF ? JJ/MM/AAAA", "Date OTIF")
If a <> "" Then
    Sheets("Stocou").Range("Tableau_Lancer_la_requête_à_partir_de_AS4003[[#Headers],[QTE_PREV]]").ListObject.QueryTable.Refresh BackgroundQuery:=False
    Sheets("Extraction ").Range("AB14").ListObject.QueryTable.Refresh BackgroundQuery:=False
    Sheets("Priorités J+1").PivotTables("Tableau croisé dynamique6").ClearAllFilters
    With Sheets("Priorités J+1")
    With .PivotTables("Tableau croisé dynamique6").PivotFields("dernière date")
           .PivotItems("28/10/2020").Visible = False
            .PivotItems(a).Visible = True
            Range("F5").Select
    End With
        .PivotTables("Tableau croisé dynamique6").PivotCache.Refresh
    End With
End If

End Sub
Le 02/11/2020 à 16:39

Non la ligne est bien placée

juste avant pivotitem(a), mettez

msgbox .PivotItems(a).Value

Cela vous renvoie quoi ?

Le 02/11/2020 à 16:49

Ceci, c'est bien ce que j'ai tapé dans l'Inputbox

capture
Le 02/11/2020 à 16:57

Supprimez la ligne Clearallfilters et essayez en changeant cette partie de code

        With .PivotTables("Tableau croisé dynamique6").PivotFields("dernière date")
        On Error Resume Next
        For i = 1 To .PivotItems.Count
            If .PivotItems(i).Value = a Then .PivotItems(i).Visible = True Else .PivotItems(i).Visible = False
        Next i
        Range("F5").Select
        End With
Le 03/11/2020 à 11:35

Bonjour Dan,

J'ai intégré votre code et ça marche !!!!!

Merci beaucoup pour votre aide !

Le 03/11/2020 à 12:18

Bonjour à tous

Dan a écrit :

Supprimez la ligne Clearallfilters et essayez en changeant cette partie de code

        With .PivotTables("Tableau croisé dynamique6").PivotFields("dernière date")
        On Error Resume Next
        For i = 1 To .PivotItems.Count
            If .PivotItems(i).Value = a Then .PivotItems(i).Visible = True Else .PivotItems(i).Visible = False
        Next i
        Range("F5").Select
        End With

Sauf erreur de ma part, en supprimant le Clearallfilters, on peut se retrouver dans la situation où aucune date n'est à True dans la boucle ce qui va planter...

Le 03/11/2020 à 12:33

Bonjour Chris,

Je ne sais pas, mais en tout cas cela fonctionne :)

Ci-dessous le code final, qui me permet de mettre à jour les extracs + filtrer le TCD en fonction de la valeur saisie dans l'Inputbox

Sub MAJ()
'
' MAJ Macro
' Met à jour les extracs + TCD
'

'
    Dim E As Object
    Dim a As String
    Set E = Sheets("Priorités J+1")
   a = InputBox("Date OTIF ? JJ/MM/AAAA", "Date OTIF")
    If a <> "" Then
    Sheets("Stocou").Select
    Range("Tableau_Lancer_la_requête_à_partir_de_AS4003[[#Headers],[QTE_PREV]]"). _
        Select
    Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False
    Sheets("Extraction ").Select
    Range("AB14").Select
    Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False
    Sheets("Priorités J+1").Select
     With ActiveSheet.PivotTables("Tableau croisé dynamique6").PivotFields( _
        "dernière date")
        On Error Resume Next
        For i = 1 To .PivotItems.Count
        If .PivotItems(i).Value = a Then .PivotItems(i).Visible = True
        Else: .PivotItems(i).Visible = False
        Next i
        Range("F5").Select
        End With
    ActiveSheet.PivotTables("Tableau croisé dynamique6").PivotCache.Refresh
    End If
End Sub
Le 03/11/2020 à 12:37

Re

Le on error va éviter le plantage mais si tu filtres d'abord sur une date plus ancienne puis sur une date plus récente, n'as tu pas 2 dates ?

Le 03/11/2020 à 12:46

re

Je vous avais enlevé tous les select qui ne servent à rien dans votre code. Pourquoi les remettez vous ?

Vous pouvez aussi rajouter l'instruction Clearallfilters que je vous ai donnée hier et ce, au même endroit du code

Edit : le code à vérifier

Sub MAJ()
'
' MAJ Macro
' Met à jour les extracs + TCD

Dim E As Object
Dim a As String
Set E = Sheets("Priorités J+1")
a = InputBox("Date OTIF ? JJ/MM/AAAA", "Date OTIF")
If a <> "" Then
    Sheets("Stocou").Range("Tableau_Lancer_la_requête_à_partir_de_AS4003[[#Headers],[QTE_PREV]]").ListObject.QueryTable.Refresh BackgroundQuery:=False
    Sheets("Extraction ").Range("AB14").ListObject.QueryTable.Refresh BackgroundQuery:=False
    Sheets("Priorités J+1").PivotTables("Tableau croisé dynamique6").ClearAllFilters
    With Sheets("Priorités J+1")
        With .PivotTables("Tableau croisé dynamique6").PivotFields("dernière date")
            On Error Resume Next
            For i = 1 To .PivotItems.Count
                If .PivotItems(i).Value = a Then .PivotItems(i).Visible = True Else: .PivotItems(i).Visible = False
            Next i
            Range("F5").Select
        End With
        .PivotTables("Tableau croisé dynamique6").PivotCache.Refresh
    End With
End If
End Sub
Le 04/11/2020 à 12:04

Effectivement Chris, j'avais 2 dates !

Dan, j'ai réintégré le code et cette fois tout va bien !!

Merci beaucoup à vous deux ! :)

Rechercher des sujets similaires à "filtrer tcd variable issue inpubox"