XL 2010 Optimisasion temps de calcul d'une macro

Erakmur · 10 Novembre 2017

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... · 11 Novembre 2017

Bon_soir

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

VB:

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 · 11 Novembre 2017

Bonsoir Si...

N'est-ce point équivalent?

VB:

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... · 11 Novembre 2017

Re

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

VB:

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 · 11 Novembre 2017

@Staple1600

Staple1600 à dit:
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 · 11 Novembre 2017

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 · 13 Novembre 2017

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 · 13 Novembre 2017

Bonjour Erakmur,

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

Erakmur · 14 Novembre 2017

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

XL 2010 Optimisasion temps de calcul d'une macro

Erakmur

XLDnaute Occasionnel

Si...

XLDnaute Barbatruc

Pièces jointes

Staple1600

XLDnaute Barbatruc

Si...

XLDnaute Barbatruc

mapomme

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

Erakmur

XLDnaute Occasionnel

Pièces jointes

mapomme

XLDnaute Barbatruc

Erakmur

XLDnaute Occasionnel

Discussions similaires