Macro beaucoup trop longue d'execution...

[jb29720]

Bonjour,
J'ai crée une macro pour analyser des effectifs et des temps de présence. J'utilise trois boutons avec la même macro mais des périmètres différents. Pour avoir des périmètres différents je sélectionne ou déselectionne des champs issus d'un TCD. Ce TCD alimentant ensuite un onglet de synthèse par le biais d'une formule liretableaucroisé. Cette manip marche très bien mais la macro est longue. Auriez vous une solution pour la rendre plus rapide? Je suis novice en VBA il s'agit ici de ma première réalisation entre autres grâce aux forums et manuels VBA... Merci d'avance

Code VBA :
Sheets("Synthèse").Select
Sheets("Synthèse").Unprotect ("abc")
Sheets("Graphes 3").Select
Sheets("Graphes 3").Unprotect ("abc")
Sheets("Effectifs").Visible = True
Sheets("BDD").Visible = True
Sheets("Répartition par Ilot").Visible = True
Sheets("Changement Scan").Visible = True
Sheets("TCD MAJ").Visible = True
Sheets("Budget").Visible = True
Sheets("Effectifs").Select
Sheets("Effectifs").Select
Range("A3").Select
ActiveCell.FormulaR1C1 = "perimetre 1"
Sheets("TCD MAJ").Select
With ActiveSheet.PivotTables("Tableau croisé dynamique2").PivotFields( _
"Ilot")
.PivotItems("Ilot1").Visible = True
.PivotItems("Ilot2").Visible = True
.PivotItems("Ilot3").Visible = True
.PivotItems("Ilot4").Visible = True
.PivotItems("Ilot5").Visible = True
.PivotItems("Ilot6").Visible = True
.PivotItems("Ilot7").Visible = True
.PivotItems("Ilot8").Visible = True
.PivotItems("Ilot9").Visible = True
.PivotItems("Ilot10").Visible = True
.PivotItems("Ilot11").Visible = True
.PivotItems("Ilot12").Visible = True
.PivotItems("Ilot13").Visible = True
End With
Sheets("TCD").Select
With ActiveSheet.PivotTables("Tableau croisé dynamique3").PivotFields( _
"Ilot")
.PivotItems("Ilot1").Visible = True
.PivotItems("Ilot2").Visible = True
.PivotItems("Ilot3").Visible = True
.PivotItems("Ilot4").Visible = True
.PivotItems("Ilot5").Visible = True
.PivotItems("Ilot6").Visible = True
.PivotItems("Ilot7").Visible = True
.PivotItems("Ilot8").Visible = True
.PivotItems("Ilot9").Visible = True
.PivotItems("Ilot10").Visible = True
.PivotItems("Ilot11").Visible = True
.PivotItems("Ilot12").Visible = True
.PivotItems("Ilot13").Visible = True
End With
Sheets("TCD MAJ").Select
ActiveWindow.SmallScroll Down:=-9
Range("B11").Select
ActiveSheet.PivotTables("Tableau croisé dynamique2").RefreshTable
Sheets("TCD").Select
ActiveWindow.SmallScroll Down:=-9
Range("B11").Select
ActiveSheet.PivotTables("Tableau croisé dynamique3").RefreshTable
Sheets("Synthèse").Select
Columns("H:T").EntireColumn.Hidden = False
NumColFin = "T"
Select Case Range("A3").Value
Case "Janvier"
NumColDebut = "I"
Case "Février"
NumColDebut = "J"
Case "Mars"
NumColDebut = "K"
Case "Avril"
NumColDebut = "L"
Case "Mai"
NumColDebut = "M"
Case "Juin"
NumColDebut = "N"
Case "Juillet"
NumColDebut = "O"
Case "Août"
NumColDebut = "P"
Case "Septembre"
NumColDebut = "Q"
Case "Octobre"
NumColDebut = "R"
Case "Novembre"
NumColDebut = "S"
Case "Décembre"
NumColDebut = "T"
Case Else
MsgBox "Erreur"
End Select
Columns(NumColDebut & ":" & NumColFin).EntireColumn.Hidden = True
Sheets("BDD").Select
ActiveWindow.SelectedSheets.Visible = False
Sheets("Effectifs").Select
ActiveWindow.SelectedSheets.Visible = False
Sheets("Répartition par Ilot").Select
ActiveWindow.SelectedSheets.Visible = False
Sheets("Changement Scan").Select
ActiveWindow.SelectedSheets.Visible = False
Sheets("TCD MAJ").Select
ActiveWindow.SelectedSheets.Visible = False
Sheets("Budget").Select
ActiveWindow.SelectedSheets.Visible = False
Sheets("Graphes 3").Select
Columns("Q:AD").EntireColumn.Hidden = False
NumColFin = "AD"
Select Case Range("A3").Value
Case "Janvier"
NumColDebut = "S"
Case "Février"
NumColDebut = "T"
Case "Mars"
NumColDebut = "U"
Case "Avril"
NumColDebut = "V"
Case "Mai"
NumColDebut = "W"
Case "Juin"
NumColDebut = "X"
Case "Juillet"
NumColDebut = "Y"
Case "Août"
NumColDebut = "Z"
Case "Septembre"
NumColDebut = "AA"
Case "Octobre"
NumColDebut = "AB"
Case "Novembre"
NumColDebut = "AC"
Case "Décembre"
NumColDebut = "AD"
Case Else
MsgBox "Erreur"
End Select
Columns(NumColDebut & ":" & NumColFin).EntireColumn.Hidden = True
Sheets("Graphes 3").Protect ("abc")
Sheets("Synthèse").Select
Sheets("Synthèse").Protect ("abc")


J'ai trois autres macro identiques seulement je ne sélectionne que certain PivotItems (ilot1 = false, ilotX =false, ...). C'est donc le périmètre qui change. Cette macro peut mettre 3 minutes à tourner ...

 

[GeoTrouvePas]

Re : Macro beaucoup trop longue d'execution...

Bonjour,

Difficile à dire sans pouvoir essayer sur un fichier exemple.

Tu pourrais déjà commencer par le grand classique :

Application.ScreenUpdating = False

Cela te ferait sûrement gagner de précieuses secondes (n'oublie surtout pas de le remettre à True à la fin de ta macro).

C'est à tester mais j'ai l'impression que la plupart du temps, tu pourrais ne pas avoir besoin de sélectionner tes feuilles pour les lire ou y écrire dedans. Tu ne devrais même pas avoir besoin de les afficher.

Pour pouvoir assainir ce code (qui semble en grande partie réalisé par l'enregistreur de macro), il faudrait que tu fasses passer un petit fichier exemple (sans données confidentielles), histoire que l'on puisse tester une ou deux modifs.

P.S. : N'oublie pas d'utiliser la balise "Code" histoire de rendre ton post plus lisible.