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

 

[Si...]

Bon_soir

Avec mon style hors usages* (sans classeur support pour approfondir)…

Sub Macro1()
  Dim n As Byte, Ws()
  Ws = Array("BP par CF", "EST", "IDF SUD", "BFC", "SDO", "PACA", "SUD EST", "MONTPELLIER", "M-PYRENEES", "NORD", "IDF NORD", "BPL", "NORMANDIE", "CENTRE")
  Application.ScreenUpdating = 0: Application.Calculation = xlCalculationManual

  'Rafraichir TCD (décoher dans le classeur d'origine)
  Application.Goto Sheets("BP par DR et par CF").[C6]
'  ActiveSheet.PivotTables("Tableau croisé dynamique4").PivotCache.Refresh
  Application.Goto Sheets("TCD BP par CF").[A6]
'  ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotCache.Refresh
  Application.Goto Sheets("BP par DR et par Site").[C6]
'  ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotCache.Refresh

  'filtrer sans vide
  For n = 0 To 13: Sheets(Ws(n)).Columns(2).AutoFilter 1, "<>": Next
  Application.Calculation = xlCalculationAutomatic
  'suite éventuelle
  Feuil1.Select
End Sub

'pour supprimer les filtres
Sub MacroN()
  Dim Sh As Worksheet
  For Each Sh In Worksheets
  If Sh.AutoFilterMode Then Sh.Columns(2).AutoFilter
  Next
End Sub

* qui sont ceux qui les propagent ? Font ils partie des 20% (ou moins encore ?) des utilisateurs qui connaissent plus de 50% des fonctionnalités d'Excel ?
Je dois avouer que je n'en suis pas mais je me soigne.

Staple, tu remarqueras qu'avec MacroN il n'y a pas de End If .

 

[Staple1600]

Bonsoir Si...

N'est-ce point équivalent?

Sub NacroM()
  Dim Sh As Worksheet
  For Each Sh In Worksheets
  Sh.AutoFilterMode = False
  Next
End Sub

PS1: J'espère que j'ai point vexé mapomme car il n'est point revenu

PS2: Sinon à propos des : , as-tu ou n'as-tu pas lu quelque article où l'on cause risque d'usage
Car je n'arrive toujours pas à retrouver où j'ai pu lire cela

PS3: Il y avait une PJ (mais avec des données confidentielles)
Mais avec ou sans, ce gros fichier faisait planter mon Excel.

 

[Si...]

Re

tu as raison, MacroN n'a plus lieu d'être comme ça. J'amende volontiers ma proposition :

Sub NacroM()
  Dim Sh As Worksheet
  For Each Sh In Worksheets:  Sh.AutoFilterMode = 0:  Next
End Sub

Quant aux cumul des ":" sur une ligne, je n'ai aucune information.
Me demander de "rechercher" c'est m'envoyer aux galères !

 

[mapomme]

@Staple1600

PS1: J'espère que j'ai point vexé mapomme car il n'est point revenu

Ah que nenni ! J'avais pensé avoir répondu avec humour (en associant fainéant et Macron et chômeur) par le fait que manifestement tu ne voulais pas mettre en œuvre ce que tu préconisais.

Mais c'est tombé à plat . Je veux bien être traité de macrophile voire de maquerauphile. mais y intercaler un n justifierai presque un clique sur l'icone Signaler .

 

[Staple1600]

Re

mapomme
Ah merci, ton retour, ça me met du baume au cœur
Vu la taule qu'est en train de se prendre les Bleus par les All Blacks (qui eux pour le coup sont pas des feignasses!)

PS: Désolé de t'avoir lu au premier degré.
Mais je suis diminué par un rhume (qui m'a empêcher de me ravitailler en bières)
Du coup j'ai l’œil torve, le nez qui coule, et le neurone mollasson

NB: J'ai corrigé le message#28 pour éviter que tu me signales o zautorités compétentes

 

[Erakmur]

Bonjour,
J'avoue que ce week end, j'avais d'autres occupations que la macro mais me revoilà. J'ai lu vos mails. Je suis un peu perdu. Avez vous trouvé une solution pour optimiser le temps de calcul ? Si oui, laquelle ?

Je vous redonne le classeur complet dépourvu de toutes données.

Cordialement

 

[mapomme]

Bonjour Erakmur,

As-tu testé le code du message #21 ?

 

[Erakmur]

Bonjour,

J'ai modifié mon travail depuis et donc je me suis permis de modifier ta macro en conséquence:
- L'onglet BP par CF et TCD BP par CF n'existe plus.
- Pour chaque onglet région et région. , il y a maintenant un onglet région DI et région DI mais la présentation n'est pas la même, sur les DI, la colonne à trier du plus petit au plus grand est en colonne L.
- A la fin de ta macro tu as mis une 2ème fois décocher vide, je pense que tu voulais mettre cocher vide, valides tu ?
- Au niveau du range. Que l'on mette $A$8:$P$44 ou $A$8:$Z$10000, qu'est que cela change ? Parce que selon l'onglet, la longueur n'est pas la même mais pour moi cela n'a pas d'importance.
- Mes modification sont elles pertinentes ?

Cordialement

Sub Macro1()
Const MesFeuilles = "BFC;BPL;CENTRE;EST;IDF NORD;IDF SUD;MONTPELLIER;M-PYRENEES;NORD;NORMANDIE;PACA;SDO;SUD EST;BFC DI;BPL DI;CENTRE DI;EST DI;IDF NORD DI;IDF SUD DI;MONTPELLIER DI;M-PYRENEES DI;NORD DI;NORMANDIE DI;PACA DI;SDO DI;SUD EST DI"
Const MesDI = "BFC DI;BPL DI;CENTRE DI;EST DI;IDF NORD DI;IDF SUD DI;MONTPELLIER DI;M-PYRENEES DI;NORD DI;NORMANDIE DI;PACA DI;SDO DI;SUD EST DI"
Const MesBP = "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("BP par DR et par Site").PivotTables("Tableau croisé dynamique1").PivotCache.Refresh

' on recalcule le classeur
Calculate

' Décocher vide

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
For Each xfeuil In Split(MesBP, ";")
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

For Each xfeuil In Split(MesDI, ";")
With Sheets(xfeuil)
.AutoFilter.Sort.SortFields.Clear
.AutoFilter.Sort.SortFields.Add Key:=Range("L8:L44"), 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("L8:L500"), 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
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