Lenteur execution macro

[TOINE38]

Bonsoir,

Je dois travaillé sur un fichier pour améliorer la planification de mon atelier, pour cela je dois copier des formules, des cellules tant que la valeur de la colonne k n'est pas vide ( environ 5000 lignes )
Etant novice en VBA, je me suis appuyé sur les différents échange sur le forum et sur le net.
Ma macro fonctionne, mais elle est longue à s'exécuter.
Aurait il vous une solution pour améliorer mon code afin qu'il tourne lus vite ?
ci dessous le code
Sub planing()


'selection de la feuille
Sheets("630-programme_fabrication-2015-").Select
'Entètes des colonnes
Range("AA1").Select
ActiveCell.FormulaR1C1 = "Numero semaine"
Range("AB1").Select
ActiveCell.FormulaR1C1 = "ANNEE"
Range("AC1").Select
ActiveCell.FormulaR1C1 = "Intervalle"
Range("AD1").Select
ActiveCell.FormulaR1C1 = "Poste old"
Range("AE1").Select
ActiveCell.FormulaR1C1 = "Departement"
Range("AF1").Select
ActiveCell.FormulaR1C1 = "Description centre de charge"
Range("AG1").Select
ActiveCell.FormulaR1C1 = "Poste"
Range("AH1").Select
ActiveCell.FormulaR1C1 = "Article"
Range("AI1").Select
ActiveCell.FormulaR1C1 = "ID"
Range("AJ1").Select
ActiveCell.FormulaR1C1 = "Heure de chargement"
Range("AK1").Select
ActiveCell.FormulaR1C1 = "Date d'échéance"
Range("AL1").Select
ActiveCell.FormulaR1C1 = "Quantité ouverte"
Range("AM1").Select
ActiveCell.FormulaR1C1 = "Statut OF"
Range("AN1").Select
ActiveCell.FormulaR1C1 = "Statut opération"

' Selectionne la première cellule du tableau
Range("k2").Select
' Boucle tant que pas vide
Do While Not (IsEmpty(ActiveCell))
' Crée les formules tant que K n'est pas vide
Cells(ActiveCell.Row, 27).Formula = "=WEEKNUM(RC[-16])"
Cells(ActiveCell.Row, 28).Formula = "=Year(RC[-17])"
Cells(ActiveCell.Row, 29).Formula = "=IF(RC[-18]<TODAY(),""RETARD"",IF(RC[-2]-WEEKNUM(TODAY())>5,""HORIZON"",RC[-2]))"
Cells(ActiveCell.Row, 30).Formula = "FINITION"
Cells(ActiveCell.Row, 31).Formula = "=(RC[-13])"
Cells(ActiveCell.Row, 32).Formula = "=(RC[-10])"
Cells(ActiveCell.Row, 33).Formula = "=VLOOKUP(RC[-1],'Mapping CC'!C[-32]:C[-31],2,0)"
Cells(ActiveCell.Row, 34).Formula = "=(RC[-28])"
Cells(ActiveCell.Row, 35).Formula = "=(RC[-30])"
Cells(ActiveCell.Row, 36).Formula = "=(RC[-21])"
Cells(ActiveCell.Row, 37).Formula = "=(RC[-26])"
Cells(ActiveCell.Row, 38).Formula = "=(RC[-29])"
Cells(ActiveCell.Row, 39).Formula = "=(RC[-27])"
Cells(ActiveCell.Row, 40).Formula = "=(RC[-27])"
' Passe à la ligne suivante
Selection.Offset(1, 0).Select
Loop

End Sub


Merci d'avance

Amicalement

Toine38

 

[Victor21]

Re : Lenteur execution macro

Bonsoir, TOINE38.

En attendant que je reconstitue -vaste tache ...- le fichier que vous avez omis de soumettre,
- voyez du côté de la suppression des "select" inutiles,
- tournez-vous vers les boucles (au moins pour les en-têtes).
- Désactivez le rafraîchissement de l'écran pendant l'exécution de la macro
- Idem pour le calcul.
Liste non exhaustive

 

[Dranreb]

Re : Lenteur execution macro

Bonsoir TOINE38 et Victor21

tournez-vous vers les boucles (au moins pour les en-têtes).

Pas d'accord: tournez vous vers du code qui descend tout droit, sans boucle nulle part :

Range("AA1:AN1").Value = Array("ANNEE", "Intervalle", etc. …)
Dim Plage As Range
Set Plage = Rows(2).Resize(Range("K60000").End(xlUp).Row - 1)
Plage.Columns(27).FormulaR1C1 = "=WEEKNUM(RC[-16])"
Plage.Columns(28).FormulaR1C1 etc.

 

[TOINE38]

Re : Lenteur execution macro

Bonsoir Victor 21,

Merci de cette rapide réponse et désolé pour le fichier joint.
Bien que je n'ai laissé qu'une dizaine de lignes le fichier est trop volumineux par rapport à la taille maxi autorisée.

Quand vous dites "suppression des select inutiles", lesquels Est-ce ?

Je ne suis vraiment pas expert en VBA, j'utilise des bouts de code par ci part là.

Merci encore de votre aide

Amicalement
Toine 38

 

[TOINE38]

Re : Lenteur execution macro

Bonsoir Dranreb

Parfais pour le code, c'est hyper rapide.
Un grand merci et vive la solidarité "Excellienne"

Bonne soirée à tous

Amicalement

Toine38

 

[Victor21]

Re : Lenteur execution macro

Bonsoir et merci, Dranreb

Bonsoir TOINE38 et Victor21
Pas d'accord: tournez vous vers du code qui descend tout droit, sans boucle nulle part :

Range("AA1:AN1").Value = Array("ANNEE", "Intervalle", etc. …)
Dim Plage As Range
Set Plage = Rows(2).Resize(Range("K60000").End(xlUp).Row - 1)
Plage.Columns(27).FormulaR1C1 = "=WEEKNUM(RC[-16])"
Plage.Columns(28).FormulaR1C1 etc.

Preuve, s'il en était besoin, que la bonne volonté ne suffit pas, et que j'en ai encore beaucoup à apprendre