Macro excel trop longue...

jb29 -  
michel_m Messages postés 18903 Date d'inscription   Statut Contributeur Dernière intervention   -
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 ...
A voir également:

1 réponse

michel_m Messages postés 18903 Date d'inscription   Statut Contributeur Dernière intervention   3 318
 
Bonjour,

Dans un 1° temps, en début de macro inscris cette ligne
Application.screenupdating=False
qui fige le défilement de l'écran et fait gagner un temps fou

ensuite évite les select-selection
par ex
Sheets("Synthèse").Select
Sheets("Synthèse").Unprotect ("abc") 
deviendrait
Sheets("synthèse").unprotect("abc")

et
Sheets("Effectifs").Select
Sheets("Effectifs").Select
Range("A3").Select
ActiveCell.FormulaR1C1 = "perimetre 1"
deviendrait
Sheets("Effectifs").range("A3")="perimetre1"


etc
ActiveWindow.SmallScroll Down:=-9 est inutile et mange du temps

maintenant regarde si rendre les feuilles visibles puis cachées est indispensable à ta macro (fais une maquette sur 1 ou 2 feuilles)

après on verra, mais il faudrait connaitre ce que tu veux faire....
0
michel_m Messages postés 18903 Date d'inscription   Statut Contributeur Dernière intervention   3 318
 
pour tes masquages de colonne, petite maquette à adapter à ta macro (économise des lignes et gestion de l'erreur: sortie de la macro si syntaxe du mois fausse)


Sub maquette_col() 
Dim annee() As String, col As String 

'initialisations 
Application.ScreenUpdating = False 
annee = Array("janvier", "Février", "mars") 'a compléter 

'affectation colonne correspondant au mois 
On Error GoTo erreur 
col = Chr(Application.Match(Range("A1"), annee, 0) + 72) '72 pour colonne I, 82 pour colonne S 
On Error GoTo 0 
'.... 

Exit Sub 
erreur: 
MsgBox "erreur de saisie" ' rejet si erreur de saisie du mois 
End Sub
0
michel_m Messages postés 18903 Date d'inscription   Statut Contributeur Dernière intervention   3 318
 
autre petite maquette démo qui montre que l'on a pas besoin de rendre une feuille visible pour travailler dedans

Sub voir()
With Sheets(2)
     .Visible = False 'on cache la feuille 2
     .Range("B2") = Sheets(1).Range("A1") 'on écrit une valeur
     .Columns("C").Hidden = True 'on masque une colonne
     .Visible = True 'on rend la feuille visible pour voir si notre bidouille fonctionne
End With
End Sub
0