MACRO EXCEL fonctionne mais lente...

Résolu
BipBip -  
Bonjour à tous,

J'ai fait ce code (voir plus bas) pour filtrer en même temps des Tableaux Croisés Dynamiques, en fonction du contenu de la cellule A1.

Cela fonctionne très bien sauf que le code est assez long = environ 1 minute 30

Auriez vous une idée pour accélerer un peu la procédure?

Merci à ceux qui m'aideront car c'est assez urgent (comme toujours!)

Bien à vous
BipBip

Sub Macro1()

Dim monPivIt As Object, Mavariable
Mavariable = Worksheets("Graphs").Range("A1").Value
Application.ScreenUpdating = False
With ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields("FDR")
For Each monPivIt In .PivotItems
monPivIt.Visible = True
On Error Resume Next
Next
For Each monPivIt In .PivotItems
If monPivIt.Name <> Mavariable Then monPivIt.Visible = False
Next
End With

With ActiveSheet.PivotTables("Tableau croisé dynamique2").PivotFields("FDR")
For Each monPivIt In .PivotItems
monPivIt.Visible = True
On Error Resume Next
Next
For Each monPivIt In .PivotItems
If monPivIt.Name <> Mavariable Then monPivIt.Visible = False
Next
End With

With ActiveSheet.PivotTables("Tableau croisé dynamique3").PivotFields("FDR")
For Each monPivIt In .PivotItems
monPivIt.Visible = True
On Error Resume Next
Next
For Each monPivIt In .PivotItems
If monPivIt.Name <> Mavariable Then monPivIt.Visible = False
Next
End With

With ActiveSheet.PivotTables("Tableau croisé dynamique4").PivotFields("FDR")
For Each monPivIt In .PivotItems
monPivIt.Visible = True
On Error Resume Next
Next
For Each monPivIt In .PivotItems
If monPivIt.Name <> Mavariable Then monPivIt.Visible = False
Next
End With
Application.ScreenUpdating = True

With ActiveSheet.PivotTables("Tableau croisé dynamique5").PivotFields("FDR")
For Each monPivIt In .PivotItems
monPivIt.Visible = True
On Error Resume Next
Next
For Each monPivIt In .PivotItems
If monPivIt.Name <> Mavariable Then monPivIt.Visible = False
Next
End With

With ActiveSheet.PivotTables("Tableau croisé dynamique6").PivotFields("FDR")
For Each monPivIt In .PivotItems
monPivIt.Visible = True
On Error Resume Next
Next
For Each monPivIt In .PivotItems
If monPivIt.Name <> Mavariable Then monPivIt.Visible = False
Next
End With

With ActiveSheet.PivotTables("Tableau croisé dynamique7").PivotFields("FDR")
For Each monPivIt In .PivotItems
monPivIt.Visible = True
On Error Resume Next
Next
For Each monPivIt In .PivotItems
If monPivIt.Name <> Mavariable Then monPivIt.Visible = False
Next
End With

End Sub

7 réponses

  1.  Le Pingou
    Bonjour BipBip,
    Je vous propose d'essayer cette procédure : 
    Sub FiltrerTdc()
Dim monPivIt As Object, Mavariable
Dim nbtdc As Long
Mavariable = Worksheets("Graphs").Range("A1").Value
nbtdc = ActiveSheet.PivotTables.Count
Application.ScreenUpdating = False
For c = 1 To nbtdc
    With ActiveSheet.PivotTables(c).PivotFields("FDR")
        .PivotItems(Mavariable).Visible = True

        For Each monPivIt In .PivotItems
            If monPivIt.Name <> Mavariable Then monPivIt.Visible = False
        Next
    End With
Next c
Application.ScreenUpdating = True
End Sub
    Merci de vos commentaires.
    2
    1. BipBip
      Waou...

      Je suis bluffé... avec votre code Pingou, je passe de 2 minutes à 2 secondes... et en bonus : plus rien ne clignote...

      Un GRAND merci pour votre aide, vous balayez d'un revers de main quelques heures de prise de tête...

      Encore merci Pingou pour votre aide (et le suivi)

      Si je peux faire quelque chose pour vous...
      Salutations
      Olivier
      0
    2. Le Pingou
      Bonsoir,
      Ca marche, c'est parfait.
      Le merci me suffit.
      Salutations.
      Le Pingou
      0
  2. Le Pingou
    Bonjour,
    Juste au passage, pourquoi 7 fois 2 boucles identiques, une devrait suffire ! 
    Sub Macro1() 
Dim monPivIt As Object, Mavariable 
Mavariable = Worksheets("Graphs").Range("A1").Value 
Application.ScreenUpdating = False 
With ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields("FDR") 
For Each monPivIt In .PivotItems 
monPivIt.Visible = True 
On Error Resume Next 
Next 
For Each monPivIt In .PivotItems 
If monPivIt.Name <> Mavariable Then monPivIt.Visible = False 
Next 
End With 
End Sub
    --
    Salutations.
    Le Pingou
    0
    1. BipBip
      Bonsoir,

      Et bien parce qu'il y a 7 TCD distincs. Dans votre code vous ne travaillez que sur le premier!

      Merci d'avance
      0
    2. Le Pingou
      Bonjour,
      Vous avez raisons l'indice du tableau m'a échappé.
      Salutations.
      Le Pingou
      0
  3. Syzygy
    Bonjour,

    En complément de la réponse ci-dessus privilégiez, si possible, une structure en Do While plutôt qu'un For Each Next.
    Le Do While ayant l'avantage d'éviter qu'Excel ne balaye tous les enregistrements et est donc plus performant qu'un For Each qui parcourera systématiquement tous les enregistrements.

    Bien à vous
    0
    1. Le Pingou
      Bonjour,
      Essayez de remplacer cette partie : 
      For Each monPivIt In .PivotItems  
monPivIt.Visible = True  
On Error Resume Next  
Next  
For Each monPivIt In .PivotItems  
If monPivIt.Name <> Mavariable Then monPivIt.Visible = False  
Next
      Par :
      .PivotItems(Mavariable).Visible = True
'For Each monPivIt In .PivotItems
'monPivIt.Visible = True
'On Error Resume Next
'Next
For Each monPivIt In .PivotItems
    If monPivIt.Name <> Mavariable Then monPivIt.Visible = False
Next

      Salutations.
      Le Pingou
      0
      2. BipBip
        Bonjour Pingou,

        Merci beaucoup pour ta réponse. Depuis mon dernier message, j'ai modifié en effet cette partie du code qui me semblait inutile. Il me semble que cette version est proche de la tienne (voir ci-dessous). Qu'en penses-tu?

        With Worksheets("TCD").PivotTables("Tableau croisé dynamique1").PivotFields("FDR")
        .ClearAllFilters
        On Error Resume Next

        For Each monPivIt In .PivotItems
        If monPivIt.Name <> Mavariable Then monPivIt.Visible = False
        Next
        End With

        @Syzygy : bonjour, Je ne sais pas faire de DoWhile... mais suis preneur si tu penses que c'est une solution plus "légère", car ma macro est relativement longue (2 minutes) et je vois les graphs liés aux TCD "s'affoler" en direct sur mon écran...
        0
        1. BipBip
          D'ailleurs je me rends compte que le On error resume next ne sert à rien ;-)
          0
        2. pijaku Modérateur
          Bonjour,
          Je ne fais que passer...
          je vois les graphs liés aux TCD "s'affoler" en direct sur mon écran...

          Fais comme Le Pingou l'a indiqué dans le code decette réponse: 
          Application.ScreenUpdating = False
          0
        3. BipBip
          Bonjour Pikaju,

          J'ai déjà intégré cette instruction, comme tu peux le voir dans mon code complet plus haut.

          Mais cela n'a aucun effet sur les graphs !!! Il continue de se mettre à jour tout au long de l'exécution du code... Je ne comprends pas pourquoi...
          0
        4. pijaku Modérateur
          C'est peut être une particularité des graphs... Mais je n'en sais rien!
          0
        5. BipBip
          Si vous pouvez m'aider sur ce point ce serait super sympa!
          0
      3. michel_m Contributeur
        Bonjour,

        de passage aussi

        tes graphes sont indépendants (ce sont une sorte d'image améliorée) de la feuille et screenupdating ne travaille que sur la feuille

        regarde si tu as la propriété visible avec les charts (j'en sais rien)
        0
        1. BipBip
          Bonjour,

          je ne comprends pas ton message. Quel est le rapport avec la propriété Visible ou non des graphs? L'idée n'est pas de les cacher mais de bloquer leur mise à jour durant l'execution du code (ainsi j'espère gagner en rapidité d'execution du code)
          0
        2. BipBip
          si vous pouvez m'aider sur ce point ce serait super sympa!
          0
        3. michel_m Contributeur
          au depart tu mets tes charts en visible=false et à la fin tu les mets en visible=True
          ils se remplissent sans avoir les yeux qui scintillent
          c'est simplement une hypothèse que je ne n'ai pas vérifié
          0
        4. BipBip
          Ok merci, pas idéal comme solution mais je vais essayer...
          0
        5. michel_m Contributeur
          c'est une piste peut ^tre pas idéale: excuses moi d'avoir essayé de t'aider mais ca ne reproduira plus.
          0
      4. Le Pingou
        Bonjour BipBip,
        C'est étonnant que les graphiques scintillent car le code 'Application.ScreenUpdating = False' doit neutraliser l'affichage.
        Question temps d'exécution de la procédure, selon mes essais est d'environ 10 secondes.
        Bien sur je n'ai pas vos données pour tester.

        Salutations.
        Le Pingou
        0

        Discussions similaires

        Transformer un chiffre en lettres dans excel sans macro
        vincentphilippos

        6 réponses