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 ...

1 réponse

  1. michel_m Messages postés 18903 Date d'inscription   Statut Contributeur Dernière intervention   3 320
     
    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
    1. michel_m Messages postés 18903 Date d'inscription   Statut Contributeur Dernière intervention   3 320
       
      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
    2. michel_m Messages postés 18903 Date d'inscription   Statut Contributeur Dernière intervention   3 320
       
      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