Optimiser temps calcul macro

J

jobd33

XLDnaute Junior
bonjour le fil,

J'aurai une petite question à vous soumettre , je souhaiterais si possible accelerer le temps de traitement de la macro que j'ai créée (ou plutot enregistrer puis bidouiller en trouvant des astuces à droite et a gauche).
Le principe de la macro est du recuperere un fichier excel pour le remetre en forme et y ajouter des informations pour à la fin réaliser un tableau croisé dynamique.
La macro fonctionne trés bien mais je trouve notamment au moment d'un calcul de moyenne sous la forme que ça rame un peu (plus de 3300 lignes mais qui sur le long terme va croitre)
=SI(ESTERR(MOYENNE.SI(H:H;H2;L:L));"";MOYENNE.SI(H:H;H2;L:L))
Cliquez pour agrandir...
qui en macro se transforme en
Range("m2").Select
Range("m2:m" & Range("B65536").End(xlUp).Row).FormulaR1C1 = "=IF(ISERR(AVERAGEIF(C[-5],RC[-5],C[-1])),"""",AVERAGEIF(C[-5],RC[-5],C[-1]))"
Cliquez pour agrandir...
pour que le calcul se fasse sur toute les lignes de remplies.

Vous auriez une petite idée ?
je vous met ci dessous tout le code j'essayerais de mettre une partie du fichier ensuite
PHP: 
Sub Ellipse2_Clic()
   Sheets("Copie extraction").Select
Range("b:c,f:f,h:h,i:m,p:q,s:u").Delete Shift:=xlToLeft
Rows("1:16").Select
    Selection.Delete Shift:=xlUp
    Range("E1:E50000").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    Sheets("Copie extraction").Select
    Range("A1:I30000").Select
    Selection.Copy
    Sheets("Résultat").Select
    Range("a1").Select
    ActiveSheet.Paste
    Columns("G:G").Select
    Selection.Find(What:="numéro d'identification:", After:=ActiveCell, LookIn _
        :=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
        xlNext, MatchCase:=False, SearchFormat:=False).Activate
    Selection.Replace What:="numéro d'identification:", Replacement:="", _
        LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:= _
        False, ReplaceFormat:=False
    Selection.Replace What:=";", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Columns("B:B").Select
    Application.CutCopyMode = False
    Selection.TextToColumns Destination:=Range("B1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 4), TrailingMinusNumbers:=True
    Columns("B:G").Select
    Range("G1").Activate
    ActiveWorkbook.Worksheets("Résultat").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Résultat").Sort.SortFields.Add Key:=Range("G2:G3011" _
        ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Résultat").Sort.SortFields.Add Key:=Range("B2:B3011" _
        ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Résultat").Sort
        .SetRange Range("B1:G30110")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Columns("G:G").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("g1").Select
    ActiveCell.FormulaR1C1 = "Statut"
    Range("G2").Select
    Range("g2:g" & Range("B65536").End(xlUp).Row).FormulaR1C1 = "=IF(RC[-1]=2,""vide"",""plein"")"
    Range("I1").Select
    ActiveCell.FormulaR1C1 = "article"
    Range("J1").Select
    ActiveCell.FormulaR1C1 = "aire d'appro"
    Range("K1").Select
    ActiveCell.FormulaR1C1 = "n°boite"
    Range("I2").Select
    Range("i2:i" & Range("B65536").End(xlUp).Row).FormulaR1C1 = "=VLOOKUP(RC[-1],pkmc!C[-8]:C[-4],3,FALSE)"
    Range("J2").Select
    Range("j2:j" & Range("B65536").End(xlUp).Row).FormulaR1C1 = "=VLOOKUP(RC[-2],pkmc!C[-9]:C[-5],4,FALSE)"
    Range("K2").Select
    Range("k2:k" & Range("B65536").End(xlUp).Row).FormulaR1C1 = "=VLOOKUP(RC[-3],pkmc!C[-10]:C[-6],5,FALSE)"
    Range("L1").Select
    ActiveCell.FormulaR1C1 = "Temps conso"
    Range("L2").Select
    Range("l2:l" & Range("B65536").End(xlUp).Row).FormulaR1C1 = "=IF(AND(RC[-5]=""vide"",RC[-4]=R[-1]C[-4]),RC[-10]-R[-1]C[-10],"""")"
    Range("m1").Select
    ActiveCell.FormulaR1C1 = "Moyenne Conso mois en cours"
   Range("m2").Select
    Range("m2:m" & Range("B65536").End(xlUp).Row).FormulaR1C1 = "=IF(ISERR(AVERAGEIF(C[-5],RC[-5],C[-1])),"""",AVERAGEIF(C[-5],RC[-5],C[-1]))"
    Range("N1").Select
    ActiveCell.FormulaR1C1 = "Mois "
    Range("n2").Select
    Range("n2:n" & Range("B65536").End(xlUp).Row).FormulaR1C1 = "=UPPER(TEXT(RC[-12],""mmmm""))"
    Range("O1").Select
    ActiveCell.FormulaR1C1 = "Moyenne conso mois"
    Range("o2").Select
    Range("o2:o" & Range("B65536").End(xlUp).Row).FormulaR1C1 = "=IF(ISERR(AVERAGEIFS(C[-3],C[-7],RC[-7],C[-1],RC[-1])<>0),"""",AVERAGEIFS(C[-3],C[-7],RC[-7],C[-1],RC[-1]))"
  
     ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
    "Résultat!b1:o999999").CreatePivotTable TableDestination:="", TableName:= _
    "Tableau croisé dynamique2"
    ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1)
    
With ActiveSheet.PivotTables("Tableau croisé dynamique2").PivotFields( _
        "aire d'appro")
        .Orientation = xlRowField
        .Position = 1
       End With
    With ActiveSheet.PivotTables("Tableau croisé dynamique2").PivotFields("article" _
        )
        .Orientation = xlRowField
        .Position = 2
    End With
       With ActiveSheet.PivotTables("Tableau croisé dynamique2").PivotFields("n°boite" _
        )
        .Orientation = xlColumnField
        .Position = 1
End With
    ActiveSheet.PivotTables("Tableau croisé dynamique2").AddDataField ActiveSheet. _
        PivotTables("Tableau croisé dynamique2").PivotFields( _
        "Moyenne Conso mois en cours"), "Nombre de Moyenne Conso mois en cours", _
        xlCount
    With ActiveSheet.PivotTables("Tableau croisé dynamique2").PivotFields( _
        "Nombre de Moyenne Conso mois en cours")
        .Caption = "Max de Moyenne Conso mois en cours"
        .Function = xlMax
    End With
     End Sub


merci d'avance
 
Trier par date Trier par votes
S

Softmama

XLDnaute Accro
Bonjour,

Tout d'abord, les .select sont rarement utiles dans une macro et les ralentissent inutilement. Ainsi les Sheets("AA").Select, Selection.Copy , Sheets("BB").Select, Range("A1").Select, ActiveSheet.Paste peuvent être optimisés et remplacés par une seule ligne :
Code: 
Sheets("AA").Copy Destination:=Sheets("BB").Range("A1")

Quant à ta formule, tu peux là encore te passer de Range("m2").Select
Par contre la suite est bien :
Code: 
Range("m2:m" & Range("B65536").End(xlUp).Row).FormulaR1C1 = "=IF(ISERR(AVERAGEIF(C[-5],RC[-5],C[-1])),"""",AVERAGEIF(C[-5],RC[-5],C[-1]))"
Juste si je comprends bien, s'il faut mettre cette formule que ds les cellules qui ne sont pas vides à la base, tu peux tester à la place :
Code: 
Range("m2:m" & Range("B65536").End(xlUp).Row).SpecialCells(xlCellTypeConstants, 23).FormulaR1C1 = "=IF(ISERR(AVERAGEIF(C[-5],RC[-5],C[-1])),"""",AVERAGEIF(C[-5],RC[-5],C[-1]))"

Encore pareil pour la suite :
Code: 
Columns("G:G").Select
    Selection.Find(...)
est long et fastidieux ! Préfère là encore mettre
Code: 
Columns("G:G").Find(...)

Toute la suite du code est de la même veine, sans avoir trop regardé dans le détail. Vire autant de .select que tu peux et la vitesse de ton code sera multiplié par 10. Reste à placer un
Code: 
Application.ScreenUpdating=False
en début de macro et
Code: 
Application.ScreenUpdating=true
à la fin pour ne pas perdre de temps avec l'affichage à l'écran des modifs pdt l'exécution de la macro et ça sera pas mal à mon avis.
 
Vote positif 0 Vote négatif
J

jobd33

XLDnaute Junior
Re : Optimiser temps calcul macro

merci je vais tester tt ça les applications screenupdating j'ai essayé mais ça met tellement de temps que ça sert a rien ^^

il faut que je les mettes false juste apres le sub et le true avant le end sub ??

merci encore
 
Vote positif 0 Vote négatif
J

jobd33

XLDnaute Junior
Re : Optimiser temps calcul macro

meme si ce n'est pas la que je vais gagner le plus je n'arrive pas à correctement modifier le debut
Sheets("Copie extraction").Select
Range("A1:I30000").Select
Selection.Copy
Sheets("Résultat").Select
Range("a1").Select
ActiveSheet.Paste
Cliquez pour agrandir...

en Sheets("Copie extraction").Copy Destination:=Sheets("Résultat").Range("A1")
ou meme Sheets("Copie extraction").Range(A1:I30000).Copy Destination:=Sheets("Résultat").Range("A1")

cela me copie bien tt mais le suite de la macro continue sur la feuille copie et non résultat ( a part quand je fais pas à pas et que je bascule sur la feuille résultat)
bizarre

Par contre "SpecialCells(xlCellTypeConstants" ne marche pas en fait je souhaite que excel me fasse le calcul tant qu'il le peu (car le nombre de ligne peu varier)
 
Dernière édition:
Vote positif 0 Vote négatif
S

Softmama

XLDnaute Accro
Re,

La macro continue sur la feuille active. (La feuille qui a appelé la macro). Si tout doit se dérouler dans la feuille "copie extraction", commence la macro avec un
With Sheets("Copie extraction")
Ainsi tous ce qui suit et qui commence par un . fera automatiquement référence à cette feuille. Par exemple :
Code: 
With Sheets("Copie extraction")
    .Range("A1").Copy Destination:=.Range("A2")
    Sheets("Toto").Range("A1").Copy Destination:= .Range("A1")
    .Columns(3).Interior.ColorIndex=4
End with
Copiera la cellule A1 de la feuille Copie Extraction vers la cellule A2
et copiera la cellule A1 de la feuille toto vers la cellule A1 de la feuille Copie Extraction
et mettra la colonne C de la feuille Copie extraction en vert.

Vois si ça fonctionne mieux désormais ?
 
Vote positif 0 Vote négatif
J

jobd33

XLDnaute Junior
Re : Optimiser temps calcul macro

non cela ne fonctionne pas en plus cela me colorie une colonne en vert lol

Sinon la ou la macro rame c'est vraiment dans le calcul des moyenne et je n'arrive pas à l'optimiser si cela est possible :confused:

PHP: 
Range("m2:m" & Range("B65536").End(xlUp).Row).FormulaR1C1 = "=IF(ISERR(AVERAGEIF(C[-5],RC[-5],C[-1])),"""",AVERAGEIF(C[-5],RC[-5],C[-1]))" 
    Range("N1").Select 
    ActiveCell.FormulaR1C1 = "Mois " 
    Range("n2").Select 
    Range("n2:n" & Range("B65536").End(xlUp).Row).FormulaR1C1 = "=UPPER(TEXT(RC[-12],""mmmm""))"
 
Vote positif 0 Vote négatif
S

Softmama

XLDnaute Accro
Re,

Heu jobd33, le post #6 t'indiquait un exemple et te donnait la marche à suivre pour que tu puisses t'en sortir. Cela nécessite que tu essaies de comprendre ce que je t'écris, et que tu t'entraines dessus. Tu as copié un morceau de code qui précisément faisait n'importe quoi (dont colorier une colonne en vert mais c'était un exemple quoi). Il t'appartient si tu as compris cet exemple d'essayer de l'adapter à l'intégralité de ton code, ce qui est fastidieux mais pas très compliqué. On est là pour te guider si tu rencontres des difficultés, mais prends le temps de t'entrainer sur des bouts de macros avant de te lancer à la refonte complète de ta macro. Lorsque tu maitriseras les notions que je t'ai détaillées qui t'éviteront l'utilisation intempestive des .Select, tu parviendras sans difficulté à reproduire ce qui pour le moment te paraît peu clair.

Courage, donc, je reste à ton écoute si tu butes sur des points précis...
 
Vote positif 0 Vote négatif
S

Softmama

XLDnaute Accro
Re: Re : Optimiser temps calcul macro

Re,

Pour le code que tu as mis en #7, tu peux l'adapter ainsi (mais il me paraît déjà pas mal) :
VB: 
Range("m2:m" & Range("B65536").End(xlUp).Row).FormulaR1C1 = "=IF(ISERR(AVERAGEIF(C[-5],RC[-5],C[-1])),"""",AVERAGEIF(C[-5],RC[-5],C[-1]))" 
    Range("N1") = "Mois " 
    Range("n2:n" & Range("N65536").End(xlUp).Row).FormulaR1C1 = "=UPPER(TEXT(RC[-12],""mmmm""))"
 
Vote positif 0 Vote négatif

Discussions similaires

Usine à gaz
  • Résolu(e)
XL 2021 Ecrire dans une une autre feuille
Réponses
3
Affichages
313
Usine à gaz
Usine à gaz
S
  • Résolu(e)
Autres ActiveWorkbook.Worksheets("vierge").AutoFilter.Sort.SortFields.Clear
2
Réponses
23
Affichages
1 K
AtTheOne
AtTheOne
A
  • Résolu(e)
Microsoft 365 plusieurs conditions dans "for each"
Réponses
3
Affichages
140
Dranreb
Dranreb
B
  • Question
XL 2013 Comment trier les nom des feuilles et fusionner leur tableaux dans une une autre feuille ?
Réponses
10
Affichages
213
Compte Supprimé 979
C
P
  • Question
XL 2019 Copier des cellules d'une feuille sur une autre
Réponses
2
Affichages
235
phoceenjo
P
lynyrd
  • Résolu(e)
XL 2016 Supprimer 1 sur 13
Réponses
6
Affichages
140
lynyrd
lynyrd
A
  • Résolu(e)
XL 2016 Regroupement dates sur TCD
Réponses
3
Affichages
329
Aldonanou
A
R
  • Question
XL 2016 excel 2016 VBA
Réponses
2
Affichages
160
rebatte
R
L
  • Question
Microsoft 365 VBA sur outlook
Réponses
14
Affichages
661
lesoldat9
L
S
  • Question
Microsoft 365 Erreur d'exécution '91'
Réponses
11
Affichages
438
Staple1600
Staple1600

Membres actuellement en ligne

16 membres et 246 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 234
Messages
2 086 470
Membres
103 226
dernier inscrit
smail12