XL 2010 Optimisasion temps de calcul d'une macro

[Erakmur]

Bonjour,

Dans l'onglet validation, vous avez un bouton vers la macro1. Cette macro, je l'ai faite à partir de l'enregistreur de macro sur un onglet et puis je l'ai dupliqué autant de fois que nécessaire. Mon soucis, c'est qu'avec l'ordinateur que m'a fourni mon entreprise, cela me prend 9 minutes à l'éxécuter.

Question: Y'a t'il un moyen de diminuer le temps de calcul de cette macro ?

Cordialement

 

[Staple1600]

Re

Ah oui exact
Je voulais parler du fichier de 2Mo
Mais je vois que tu l'as supprimé.

Mais je ne sais toujours pas si tu as testé la macro que je t'ai proposé dans le message#10

 

[Erakmur]

Je ne sais pas comment intégrer ta macro à l'intérieur de ma macro en remplacement des décocher vide

 

[Staple1600]

Re

Il ne faut pas l'intégrer dans ton code pour le moment mais juste faire un copier/coller et l’exécuter à part
(juste pour voir déjà si le test est concluant)

Ensuite si ca marche, tu pourras la mettre dans ton code.

 

[Erakmur]

Je vais aller me coucher, je suis claqué, je verrai cela demain
Bonne nuit

 

[Staple1600]

Re

Voici où il faudra la mettre

Sub Macro1()
Dim ws As Worksheet
Application.ScreenUpdating = False
'Décocher vide
For Each ws In Worksheets
If ws.AutoFilterMode = True Then
ws.AutoFilter.Range.AutoFilter Field:=2, Criteria1:="<>"
End If
Next
' Rafraichir tableau croisé dynamique

    Sheets("BP par DR et par CF").Activate
    Range("C6").Select
'...ici la suite de ta macro
End Sub

 

[mapomme]

Bonjour à Erakmur, Staple1600, job75,

Essayez le code suivant (à vérifier par vos soins attentionnés puisque pas de fichier anonymisé) :

Option Explicit

Sub Macro1()
Const MesFeuilles = "BFC;BPL;CENTRE;EST;IDF NORD;IDF SUD;MONTPELLIER;M-PYRENEES;NORD;NORMANDIE;PACA;SDO;SUD EST"
Dim xfeuil, t0 As Double

   'Heure départ
   t0 = Timer
   Application.ScreenUpdating = False
   ' passage en calcul sur ordre
   Application.Calculation = xlCalculationManual
   'si error, on saute à FIN: pour remette le calcul en automatique
   On Error GoTo FIN

   ' Rafraichir tableau croisé dynamique
   Sheets("BP par DR et par CF").PivotTables("Tableau croisé dynamique4").PivotCache.Refresh
   Sheets("TCD BP par CF").PivotTables("Tableau croisé dynamique1").PivotCache.Refresh
   Sheets("BP par DR et par Site").PivotTables("Tableau croisé dynamique1").PivotCache.Refresh

   ' on recalcule le classeur
   Calculate

   ' Décocher vide
   Sheets("BP par CF").Range("$A$8:$P$254").AutoFilter Field:=2

   For Each xfeuil In Split(MesFeuilles, ";")
      Sheets(xfeuil).Range("$A$8:$P$44").AutoFilter Field:=2
      Sheets(xfeuil & ".").Range("$A$8:$P$44").AutoFilter Field:=2
   Next xfeuil

   ' Filtre du plus petit au plus grand au % de réalisation
   ActiveWorkbook.Worksheets("BP par CF").AutoFilter.Sort.SortFields.Clear
   ActiveWorkbook.Worksheets("BP par CF").AutoFilter.Sort.SortFields.Add Key:= _
      Range("M8:M254"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
   With ActiveWorkbook.Worksheets("BP par CF").AutoFilter.Sort
      .Header = xlYes
      .MatchCase = False
      .Orientation = xlTopToBottom
      .SortMethod = xlPinYin
      .Apply
   End With

   ' Filtre du plus petit au plus grand au % de réalisation
   For Each xfeuil In Split(MesFeuilles, ";")
      With Sheets(xfeuil)
         .AutoFilter.Sort.SortFields.Clear
         .AutoFilter.Sort.SortFields.Add Key:=Range("M8:M44"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
         With .AutoFilter.Sort
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
         End With
      End With

      With Sheets(xfeuil & ".")
         .AutoFilter.Sort.SortFields.Clear
         .AutoFilter.Sort.SortFields.Add Key:=Range("M8:M500"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
         With .AutoFilter.Sort
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
         End With
      End With
   Next xfeuil

   ' Décocher vide
   Sheets("BP par CF").Select
   ActiveSheet.Range("$A$8:$P$254").AutoFilter Field:=2, Criteria1:="<>"

   ' Décocher vide
   For Each xfeuil In Split(MesFeuilles, ";")
      Sheets(xfeuil).Range("$A$8:$P$44").AutoFilter Field:=2, Criteria1:="<>"
      Sheets(xfeuil & ".").Range("$A$8:$P$500").AutoFilter Field:=2, Criteria1:="<>"
   Next xfeuil

FIN:
   If Err.Number > 0 Then MsgBox "Erreur n° " & Err.Number & vbLf & Err.Description
   Application.Calculation = xlCalculationAutomatic
   Application.Goto Sheets("Validation").Range("a1"), True
   MsgBox Format(Timer - t0, "0.0 \ sec.")
End Sub

 

[Staple1600]

Bonjour le fil, le forum

mapomme
Juste pour savoir, chez toi, mon code ne fonctionne pas?
Sur mon test, un classeur de 4 feuilles dont une sans filtre
mon code décoche vide si il y un critère après Field:=2
Sinon il se passe rien.
Pas chez toi?
Et dans ton code, tu mets en commentaire
'Coder vide
avec la syntaxe qui chez moi décoche vide

Me trompe-je ou suis-je mal réveillé?

 

[mapomme]

Bonjour Staple1600,

Juste pour savoir, chez toi, mon code ne fonctionne pas?
Sur mon test, un classeur de 4 feuilles dont une sans filtre
mon code décoche vide si il y un critère après Field:=2
Sinon il se passe rien.
Pas chez toi?

Effectivement, il se passe d'étrange chose... j'enquêquête.

Et dans ton code, tu mets en commentaire
'Coder vide
avec la syntaxe qui chez moi décoche vide

C'est une erreur, j'ai corrigé.

 

[Staple1600]

Re

Merci mapomme
Maintenant je sais que je suis bien réveillé

Et quid de ma syntaxe?
(Ça marche chez toi?)
J'ai testé avec des plages identiques sur chaque feuille, mais je suis pas sur qu'AutoFilter.Range fonctionne si les plages filtrées sont différentes sur chaque feuille)
T'en pense quoi?

 

[mapomme]

Re,

J'ai testé avec des plages identiques sur chaque feuille, mais je suis pas sur qu'AutoFilter.Range fonctionne si les plages filtrées sont différentes sur chaque feuille)

Chez moi, ça fonctionne. VBA prend bien la plage de l'autofilter de chaque feuille.

 

[Staple1600]

Re

@mapomme
Donc on peut boucler sur toutes les feuilles sans se préoccuper de leur noms et sans spécifier la plage filtrée pour chaque feuille?
C'est là que j'avais un doute

 

[mapomme]

Re,

Donc on peut boucler sur toutes les feuilles sans se préoccuper de leur noms et sans spécifier la plage filtrée pour chaque feuille?
C'est là que j'avais un doute

A priori, tu peux lever le doute. Du coup, je pourrais modifier ma proposition en appliquant ta syntaxe. Mais je n'en ai pas le courage.

 

[Staple1600]

Re

Moi, si j'avais du courage, ce serait pour mettre toutes les données de ces N feuilles dans une seule feuille (qui ferait office de base de données)
Et ensuite je manipulerai ces données avec N TCD sur une seule feuille.

Mais cela c'est si j'étais moi et si j'étais macronphile et prêt à tout pour lutter contre la fainéantise

 

[mapomme]

@Staple1600

et si j'étais macronphile et prêt à tout pour lutter contre la fainéantise

Tu ne serais pas un peu chômeur toi ?

 

[Staple1600]

Re

Non pourquoi?
Et comment peut-on être un peu chômeur?
Soit on l'est, soit on ne l'est pas.

C'était juste un trait d'humour
(une simple association d'idée: courage->labeur->travail->actualités->fainéant->macron)

Par contre mapomme, toi tu serais un peu macronphile makroutphile?
(Je sais déjà que tu es macrophile)