MACRO EXCEL fonctionne mais lente...

Résolu
BipBip -  
Le Pingou Messages postés 12276 Date d'inscription   Statut Contributeur Dernière intervention   -
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 Messages postés 12276 Date d'inscription   Statut Contributeur Dernière intervention   1 478
     
    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 Messages postés 12276 Date d'inscription   Statut Contributeur Dernière intervention   1 478
       
      Bonsoir,
      Ca marche, c'est parfait.
      Le merci me suffit.
      Salutations.
      Le Pingou
      0
  2. Le Pingou Messages postés 12276 Date d'inscription   Statut Contributeur Dernière intervention   1 478
     
    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 Messages postés 12276 Date d'inscription   Statut Contributeur Dernière intervention   1 478
       
      Bonjour,
      Vous avez raisons l'indice du tableau m'a échappé.
      Salutations.
      Le Pingou
      0
  3. Syzygy Messages postés 404 Statut Membre 147
     
    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
  4. Le Pingou Messages postés 12276 Date d'inscription   Statut Contributeur Dernière intervention   1 478
     
    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

  5. Vous n’avez pas trouvé la réponse que vous recherchez ?

    Posez votre question
  6. 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 Messages postés 13513 Date d'inscription   Statut Modérateur Dernière intervention   2 773
       
      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 Messages postés 13513 Date d'inscription   Statut Modérateur Dernière intervention   2 773
       
      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
  7. michel_m Messages postés 18903 Date d'inscription   Statut Contributeur Dernière intervention   3 320
     
    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 Messages postés 18903 Date d'inscription   Statut Contributeur Dernière intervention   3 320
       
      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 Messages postés 18903 Date d'inscription   Statut Contributeur Dernière intervention   3 320
       
      c'est une piste peut ^tre pas idéale: excuses moi d'avoir essayé de t'aider mais ca ne reproduira plus.
      0
  8. Le Pingou Messages postés 12276 Date d'inscription   Statut Contributeur Dernière intervention   1 478
     
    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 -
tontong -

6 réponses