Synchronisation des filtres de 2 TCD en VBA_ optimis. code

Le 23/04/2014 à 12:36

Bonjour,

Voici mon problème:

J'ai sur une meme fueille, 2 TCD qui sont issus de 2 tableaux differents mais dont certains champs ont les même valeurs.

Je voudrais que lorsque j'effectue un filtre sur un des deux TCD, ce meme filtre s'applique à l'autre.

J'ai trouvé ce code sur un autre sujet. Il semble bien marché, cependant ma base de donnée étant de taille importante, le programme est très long à exécuter.

En effet il balaye l'ensemble des différentes country et teste à chaque fois si elle est visible ou non, puis met le nom de la country visible dans un tableau. Ce tableau est ensuite utiliser pour affecter le meme filtre au TCD 2.

Peut etre auriez vous une idée pour optimiser ce code? J'avais pensé eventuellement à ne pas balayer l'ensemble des country mais seulement celles qui sont déjà activées mais je ne sais pas le faire.

Merci beaucoup par avance si jamais vous pouvez m'aider.

Matthieu.

Sub OneForAll()
Dim PT_MAIN As PivotTable
Dim PT As PivotTable
Dim PFN(), PF As Integer, P, I

ActiveWorkbook.RefreshAll

'table de référence
Set PT_MAIN = ActiveSheet.PivotTables("STATISTICS")
I = 1

'recuperer les noms de filtres inactifs
For PF = 1 To PT_MAIN.PivotFields("COUNTRY").PivotItems.Count
    If Not PT_MAIN.PivotFields("COUNTRY").PivotItems(PF).Visible Then
        'redimensionner pfn en fonction du nombre de filtres inactif sur le champ AA
       ReDim Preserve PFN(1 To I)  'preserve pour ne pas perdre les données précédemment inscrites
       'l'ajouter
       PFN(I) = PT_MAIN.PivotFields("COUNTRY").PivotItems(PF).Name
        I = I + 1   'on incrémente en prévision du prochain filtres inactif à ajouter
   End If
Next PF

'nb de filtre inactifs
On Error GoTo ShowAll
I = UBound(PFN)
On Error GoTo 0

'les appliquer sur les autres tables pivot
For Each PT In ActiveSheet.PivotTables
    'sauf si c'est la table pivot de référence
   If Not PT.Name = PT_MAIN.Name Then
        With PT
            'activation de la selection multiple
           PT.PivotFields("COUNTRY").EnableMultiplePageItems = True
            'on affiche tout les filtres disponibles
           For Each P In PT.PivotFields("COUNTRY").PivotItems
                P.Visible = True
            Next P
            'on désactive les filtres devant etre inactif
           If Not I = 0 Then
                For PF = 1 To I
                    PT.PivotFields("COUNTRY").PivotItems(PFN(PF)).Visible = False
                Next PF
            End If
        End With
    End If
Next PT

Exit Sub

ShowAll:
I = 0
Resume Next

End Sub
Le 23/04/2014 à 13:44

Bonjour,

Une proposition à tester

For Each PT In ActiveSheet.PivotTables
    'sauf si c'est la table pivot de référence
  If Not PT.Name = PT_MAIN.Name Then
        With PT
            'activation de la selection multiple
          PT.PivotFields("COUNTRY").EnableMultiplePageItems = True
            'on affiche tout les filtres disponibles
        PT.PivotFields("COUNTRY").ClearAllFilters           
            'on désactive les filtres devant etre inactif
          If Not I = 0 Then
                For PF = 1 To I
                    PT.PivotFields("COUNTRY").PivotItems(PFN(PF)).Visible = False
                Next PF
            End If
        End With
Le 23/04/2014 à 14:45

Bonjour, tout d'abord merci beaucoup pour la réponse très rapide.

Vous avez raison, il s'agit bien de la seconde partie qui est lourde.

Je pense que votre proposition allège un peu mais pas assez pour rendre la macro utilisable malheureusement.

Ce qui est long en fait c'est de désactiver un par un les noms. J'ai donc pensé à plutot remplir le tableau PFN avec les valeurs que je veux visibles et puis ensuite de les répercuter dans le second TCD.

Mon problème est que je ne connais pas de fonction VBA qui permette de désactiver toutes les valeurs d'un coup (un peu comme le clearAllFilter mais à l'opposé).

Connaitriez vous cela?

Je vous joins de nouveau le code que j'ai modifié.

Encore une fois merci beaucoup.

Matthieu.

Sub OneForAll()
Dim PT_MAIN As PivotTable
Dim PT As PivotTable
Dim PFN(), PF As Integer, P, I
Application.ScreenUpdating = False

'table de référence
Set PT_MAIN = ActiveSheet.PivotTables("Tableau croisé dynamique8")
I = 1

'recuperer les noms de filtres inactifs
For PF = 1 To PT_MAIN.PivotFields("Nom fournis").PivotItems.Count
   If PT_MAIN.PivotFields("Nom fournis").PivotItems(PF).Visible Then
        'redimensionner pfn en fonction du nombre de filtres inactif sur le champ AA
       ReDim Preserve PFN(1 To I)  'preserve pour ne pas perdre les données précédemment inscrites
       'l'ajouter
       PFN(I) = PT_MAIN.PivotFields("Nom fournis").PivotItems(PF).Name
        I = I + 1   'on incrémente en prévision du prochain filtres inactif à ajouter
   End If
Next PF

'nb de filtre inactifs
On Error GoTo ShowAll
I = UBound(PFN)
On Error GoTo 0

MsgBox (I)

Set PT = ActiveSheet.PivotTables("Tableau croisé dynamique9")
        With PT
            'activation de la selection multiple
         PT.PivotFields("Nom fournis").EnableMultiplePageItems = True
            'on affiche tout les filtres disponibles
        PT.PivotFields("Nom fournis").ClearAllFilters
            'on désactive les filtres devant etre inactif
       For Each P In PT.PivotFields("COUNTRY").PivotItems
                P.Visible = False
            Next P
         If Not I = 0 Then
                For PF = 1 To I
                    PT.PivotFields("Nom fournis").PivotItems(PFN(PF)).Visible = True
                Next PF
            End If
        End With

Exit Sub

ShowAll:
I = 0
Resume Next
Application.ScreenUpdating = True
I = 0
ReDim PFN(I)

End Sub
Le 23/04/2014 à 14:53

Re,

Un fichier serait intéressant pour continuer

Sinon quel est le nombre de "Country"?

Le 23/04/2014 à 15:53

Bonjour,

Oui en effet cela serait plus pratique.

Voici le fichier, vueillez m'excuser du délais, j'ai du modifier les données car il s'agit d'un fichier pour le travail.

La macro telle qu'elle est ne tourne pas car excel n'arrive pas à désactiver tous les "Nom fournis".

Peut etre allez vous pouvoir m'aider.

Merci d'avance.

Matthieu

30synchronisationfiltrestcd-matthieu4565.xlsm (204.01 Ko)
Le 23/04/2014 à 17:37

Re,

A tester.

Je vais prendre un doliprane

48synchronisationfiltrestcd-matthieu4565-v1.xlsm (205.22 Ko)
Le 23/04/2014 à 17:50

Re,

Ca à l'air de marcher. Je vais essayer de l'adapter au vrai fichier maintenant.

Quoi qu'il en soit infiniement merci pour votre temps et votre aide .

Je vous dis dès que ça marche.

Merci encore, bonne soirée

Matthieu

Le 25/04/2014 à 09:27

Bonjour,

Le code marche bien.

Sur le vrai fichier il continue de prendre du temps, pour l'accélérer un peu je lui ai dit de ne décocher que les cases qui sont préalablement cochées, et ainsi j'arrive à gagner un peu de performance.

Je pense que l'opération est lourde en elle meme et je ne pourrai pas l'optimiser plus (une 20aine de seconde ce qui me satisfait).

En tout cas merci beaucoup encore.

Bonne journée.

Matthieu

Le 25/04/2014 à 10:18

Bonjour,

J'ai modifié le code en ajoutant :

pt.ManualUpdate=True
pt.ManualUpdate=False

A te relire.

67synchronisationfiltrestcd-matthieu4565-v1.xlsm (203.57 Ko)
Rechercher des sujets similaires à "synchronisation filtres tcd vba optimis code"