XL 2016 Lenteur à l'insertion de ligne en VBA

[Nicocotte125]

Bonjour à tous...

Je suis confronté à un dilemme de lenteur sur de la manipulation de base de donnée (xXL). J'ai bien conscience que mon fichier ne sera jamais un foudre de guerre vu la quantité de données qu'il doit manipuler mais je pense avoir identifier que 50% du temps de traitement (au bas mot) est du à un seul phénomène (insertion de ligne).

Je plante le décor :

• Il s'agit de mettre sous forme d'une base de données une série d'approximativement 500 lignes de commandes
• Chaque ligne de commandes représente un article qui est composé d'approximativement 15 sous-ensembles / articles réparti sur 3 niveaux d'arborescence.
• Pour chaque sous-ensembles / articles je pioche leur "data" dans une liste de 16000 lignes

Autrement dit a grand renfort de while/ do & For/next je demande à ma macro de parcourir et copier des "data" en pagaille. De la façon dont je procède (et je ne vois pas comment faire autrement), j'insère des lignes dans ma feuille pour chacun des sous ensembles (15 x 500 = 7500 lignes) pour détailler le contenu de chaque ligne de commande. Lorsque j'éxécute la macro pas à pas (F8), je me suis aperçu que l'insertion de ligne prenait une petite seconde (en soit ce n'est pas très grave) mais dans mon cas 7500 fois une petite seconde ca fait long ! j'ai déjà réviser mon code sur certains points pour en accélérer l'éxécution :

• Recours a des filtres dans la base article
• Système de reconnaissance des commandes déjà présentes la fois précédentes
• Etc...
• Application.CutCopyMode = False
• Application.ScreenUpdating = False (indispensable sinon le poste de travail fin à cours de ressources et plante !)
• Application.Calculation = xlManual (Très utile dans mon cas)
• Application.EnableEvents = False
• Sheets("Mouvements").DisplayPageBreaks = False (plus au cas ou)
• que je me suis interdit d'avoir recours à :
  • .Select
  • .Copy
  • .Paste
  • ActiveSheet

-> J'ai lu, sur le net, qu'effectivement à chaque insertion de ligne Excel doit copier le format le ligne précédente pour le dupliquer sur la ligne fraichement insérée. Aux dires de certains c'est cette action qui demande pas mal de ressources.

Sans réellement le programmer j'ai tenté de simuler l'expérience avec un tableau auquel j'ajoute des lignes mais je n'ai pas l'impression qu'à chaque clic droit l'opération soit significativement plus rapide.

Bref si quelqu'un à une idée pour faire que cette "insertion de ligne" soit aussi rapide que la Supra de Dominic TORETTO !

Au plaisir de vous relire...

PS n°1 : je vais sans doute me faire "rouspéter" vu mon code hardcore mais le fichier est tellement complexe que pour le moment je programme en mode "ULTRA TRES EXPLICIT" pour éviter de me perdre entre la alias de fonction et les variables
PS : le fichier est franchement lourd et de vous l'envoyer je ne pense pas que ce soit pertinent (qui plus est il y a confidentiel €,€€)...
Je vous ai donc extrait le morceau de code ci-dessous (avec en rouge la ligne d'insertion en question) :

...
Derniere_Ligne_Besoin = Sheets("Mouvements").Cells(Rows.Count, 1).End(xlUp).Row


'Pour chaque niveau hiérarchique dans l'arborescence
Do While Hierarchie <= Max_Hierarchie
Takt_Besoin = Derniere_Ligne_Besoins_Precedents + 1

'Pour chaque article de la liste de besoin​

Do While Takt_Besoin <= Sheets("Mouvements").Cells(Rows.Count, 1).End(xlUp).Row​

'S'il s'agit d'un semi-fini du niveau hiérarchique considéré​

Ligne_Besoin_Article = 0​

If InStr(1, Sheets("Mouvements").Cells(Takt_Besoin + Ligne_Besoin_Article, 5).Value, "ý") = Hierarchie Then​

'Pour chaque article concerné de la base d'article BdD YCONDPAL issue de X3​

Sheets("BdD ycondpal").ListObjects("BdD_ycondpal").Range.AutoFilter Field:=2, Criteria1:=Sheets("Mouvements").Cells(Takt_Besoin, 7).Value​

If Application.Subtotal(3, Sheets("BdD ycondpal").Range("A2:S" & Derniere_Ligne_Article)) <> 0 Then​

Extrait_Nomenclature = Sheets("BdD ycondpal").Range("A2:S" & Derniere_Ligne_Article).SpecialCells(xlCellTypeVisible).Rows​

​

For Takt_Article = 1 To UBound(Extrait_Nomenclature)​

Ligne_Besoin_Article = Ligne_Besoin_Article + 1​

Sheets("Mouvements").Cells(Takt_Besoin + Ligne_Besoin_Article, 1).EntireRow.Insert Shift:=xlDown​

Sheets("Mouvements").Rows(Takt_Besoin + Ligne_Besoin_Article).Borders(xlEdgeTop).LineStyle = xlNone​

Sheets("Mouvements").Cells(Takt_Besoin + Ligne_Besoin_Article, 1).Value = Sheets("Mouvements").Cells(Takt_Besoin + Ligne_Besoin_Article - 1, 1).Value​

Sheets("Mouvements").Cells(Takt_Besoin + Ligne_Besoin_Article, 2).FormulaR1C1 = "=IF(COUNTIF('BdD ycdecrs'!C,Mouvements!RC[-1])<>0,"""",""X"")"​

Sheets("Mouvements").Cells(Takt_Besoin + Ligne_Besoin_Article, 5).Value = String(Hierarchie, " ") & Extrait_Nomenclature(Takt_Article, 1)​

Sheets("Mouvements").Cells(Takt_Besoin + Ligne_Besoin_Article, 7).Value = Extrait_Nomenclature(Takt_Article, 8)​

Sheets("Mouvements").Cells(Takt_Besoin + Ligne_Besoin_Article, 8).Value = Extrait_Nomenclature(Takt_Article, 9)​

Sheets("Mouvements").Cells(Takt_Besoin + Ligne_Besoin_Article, 12).Value = Extrait_Nomenclature(Takt_Article, 10)​

Sheets("Mouvements").Cells(Takt_Besoin + Ligne_Besoin_Article, 13).Value = Extrait_Nomenclature(Takt_Article, 11) * Extrait_Nomenclature(Takt_Article, 13)​

Sheets("Mouvements").Cells(Takt_Besoin + Ligne_Besoin_Article, 14).Value = Extrait_Nomenclature(Takt_Article, 12)​

Sheets("Mouvements").Cells(Takt_Besoin + Ligne_Besoin_Article, 16 + 2 * Hierarchie).FormulaR1C1 = "=IF(RC[-1]=0,0,MIN(0,GETPIVOTDATA(""Qté ART[niv" & Hierarchie & "]"",'Mvt ART-niv" & Hierarchie & "'!R1C1,""Réf."",RC[" & -9 - 2 * Hierarchie & "],""Désignation"",RC[" & -8 - 2 * Hierarchie & "],""Dispo" & Chr(10) & "nécessaire"",RC[" & 11 - 2 * Hierarchie & "])))"​

Sheets("Mouvements").Cells(Takt_Besoin + Ligne_Besoin_Article, 27).FormulaR1C1 = "=IFERROR(INT(MIN(RC[-3]:RC[-1])),RC[-21])"​

​

'Arrondi s'il s'agit d'un article en vrac ou à l'unité​

If Sheets("Mouvements").Cells(Takt_Besoin + Ligne_Besoin_Article, 14).Value = "PCE" Then​

Sheets("Mouvements").Cells(Takt_Besoin + Ligne_Besoin_Article, 15 + 2 * Hierarchie).FormulaR1C1 = "=ROUNDDOWN(R[-" & Ligne_Besoin_Article & "]C[-1]*RC[" & -3 - 2 * Hierarchie & "]/RC[" & -2 - 2 * Hierarchie & "]*(1+taux_Rebuts),0)"​

Else​

Sheets("Mouvements").Cells(Takt_Besoin + Ligne_Besoin_Article, 15 + 2 * Hierarchie).FormulaR1C1 = "=R[-" & Ligne_Besoin_Article & "]C[-1]*RC[" & -3 - 2 * Hierarchie & "]/RC[" & -2 - 2 * Hierarchie & "]*(1+taux_Rebuts)"​

End If​

​

'S'il s'agit d'un Semi-Fini​

If InStr(1, Extrait_Nomenclature(Takt_Article, 1), "ý") <> 0 Then​

Max_Hierarchie = Hierarchie + 1​

Sheets("Mouvements").Cells(Takt_Besoin + Ligne_Besoin_Article, 3).Value = Sheets("Mouvements").Cells(Takt_Besoin + Ligne_Besoin_Article, 1) & " - " & Sheets("Mouvements").Cells(Takt_Besoin + Ligne_Besoin_Article, 7)​

Sheets("Mouvements").Cells(Takt_Besoin + Ligne_Besoin_Article, 4).FormulaR1C1 = "=IF(OR(COUNTIF(Planification!C[-2],Mouvements!RC[-1])<>0,RC[-1]=0),"""",""X"")"​

Sheets("Mouvements").Cells(Takt_Besoin + Ligne_Besoin_Article, 9).FormulaR1C1 = "Semi-Fini CONDIVEX"​

Sheets("Mouvements").Cells(Takt_Besoin + Ligne_Besoin_Article, 23).FormulaR1C1 = "=VLOOKUP(RC[-20],Planification!C[-21]:C[4],26,FALSE)"​

Sheets("Mouvements").Cells(Takt_Besoin + Ligne_Besoin_Article, 24).FormulaR1C1 = "=VLOOKUP(RC[-21],Planification!C[-22]:C[1],24,FALSE)"​

Sheets("Mouvements").Cells(Takt_Besoin + Ligne_Besoin_Article, 28).FormulaR1C1 = "=IF(R[" & -Ligne_Besoin_Article & "]C[-4]<RC[-5],""TROP TARD"","""")"​

Sheets("Mouvements").Cells(Takt_Besoin + Ligne_Besoin_Article, 29).FormulaR1C1 = "=-MAX(RC[-14]:RC[-8])"​

​

'S'il s'agit d'un Article​

Else​

Sheets("Mouvements").Cells(Takt_Besoin + Ligne_Besoin_Article, 25).FormulaR1C1 = "=R[-" & Ligne_Besoin_Article & "]C[-1]-Delai_Picking"​

Sheets("Mouvements").Cells(Takt_Besoin + Ligne_Besoin_Article, 26).FormulaR1C1 = "=INT(RC[-1]-Delai_QC)"​

End If​

​

​

Next​

Sheets("Mouvements").Rows(Takt_Besoin + 1 & ":" & Takt_Besoin + Ligne_Besoin_Article).Rows.Group​

Application.StatusBar = "Détail Fam " & Takt_Besoin & "/" & Sheets("Mouvements").Cells(Rows.Count, 1).End(xlUp).Row & "/ hiérarchie" & Hierarchie​

Else​

Sheets("Mouvements").Rows(Takt_Besoin + Ligne_Besoin_Article).Delete Shift:=xlUp​

Sheets("Mouvements").Rows(Takt_Besoin + Ligne_Besoin_Article + 1).Delete Shift:=xlUp​

Sheets("Mouvements").Rows(Takt_Besoin + Ligne_Besoin_Article + 2).Delete Shift:=xlUp ​

End If​

Else​

End If​

Takt_Besoin = Takt_Besoin + Ligne_Besoin_Article + 1​

Loop​

Hierarchie = Hierarchie + 1​

Takt_Besoin = 0​

Loop

 

[tbft]

Bonjour

Sans fichier, pas évidant de debugger.
Je dirais d'essayer un tableau.

 

[CISCO]

Bonsoir à tous, bonsoir Tbft

Même remarque que tbft : Est-ce que tu ne pourrais pas faire avec un ou des tableaux (Array) ?

@ plus

 

[Nicocotte125]

Merci pour vous réponses ;-)

Je vais prendre le temps de faire une version non confidentielle, vous permettant de faire tourner la macro (mais grosso modo pour le moment ça prend 1 heure environ)...

je vais quand même tester le tableau sur une feuille excel...et mettre tout ça sur le me fichiers.

Thanks !

 

[Nicocotte125]

Merci pour vous réponses ;-)

Je vais prendre le temps de faire une version non confidentielle, vous permettant de faire tourner la macro (mais grosso modo pour le moment ça prend 1 heure environ)...

je vais quand même tester le tableau sur une feuille excel...et mettre tout ça sur le me fichiers.

Thanks !

Je ne ferme par encore ce fil de discussion mais j'ai déjà fait une grosse avancée.

• Plutôt que d'insérer [500 commandes] x [15 articles] = 7500 fois "1" ligne
• j'insère 500 x [3 niv. hiérarchie] = 1500 fois "5" lignes

Ca va 5 fois plus vite, faisant qu'une heure se transforme en 10min environ, en déplaçant (presqu') une simple ligne de code !

Coté code avant j'avais :
...
'Pour chaque article concerné de la base d'article BdD YCONDPAL issue de X3
Sheets("BdD ycondpal").ListObjects("BdD_ycondpal").Range.AutoFilter Field:=2, Criteria1:=Sheets("Mouvements").Cells(Takt_Besoin, 7).Value

If Application.Subtotal(3, Sheets("BdD ycondpal").Range("A2:S" & Derniere_Ligne_Article)) <> 0 Then​

Extrait_Nomenclature = Sheets("BdD ycondpal").Range("A2:S" & Derniere_Ligne_Article).SpecialCells(xlCellTypeVisible).Rows​

​

For Takt_Article = 1 To UBound(Extrait_Nomenclature)​

Ligne_Besoin_Article = Ligne_Besoin_Article + 1​

Sheets("Mouvements").Cells(Takt_Besoin + Ligne_Besoin_Article, 1).EntireRow.Insert Shift:=xlDown​

...​

Maintenant j'ai :
...
'Pour chaque article concerné de la base d'article BdD YCONDPAL issue de X3
Sheets("BdD ycondpal").ListObjects("BdD_ycondpal").Range.AutoFilter Field:=2, Criteria1:=Sheets("Mouvements").Cells(Takt_Besoin, 7).Value

If Application.Subtotal(3, Sheets("BdD ycondpal").Range("A2:S" & Derniere_Ligne_Article)) <> 0 Then​

Extrait_Nomenclature = Sheets("BdD ycondpal").Range("A2:S" & Derniere_Ligne_Article).SpecialCells(xlCellTypeVisible).Rows​

Nbr_Ligne_Nomenclature = Sheets("BdD ycondpal").Range("A2:S" & Derniere_Ligne_Article).SpecialCells(xlCellTypeVisible).Rows.Count​

Sheets("Mouvements").Rows(Takt_Besoin + 1 & ":" & Takt_Besoin + Nbr_Ligne_Nomenclature).EntireRow.Insert Shift:=xlDown​

For Takt_Article = 1 To UBound(Extrait_Nomenclature)​

Ligne_Besoin_Article = Ligne_Besoin_Article + 1​

Sheets("Mouvements").Cells(Takt_Besoin + Ligne_Besoin_Article, 1).EntireRow.Insert Shift:=xlDown​

...​

Toutefois, je reviendrai sur ce fil de discussion plus tard avec un fichier simplifié pour que vous puissiez me faire éventuellement part de vos idées.... ;-)

 

[Nicocotte125]

Bonjour

Après avoir cherché un bon bout de temps, et parcouru pas mal de lecture sur les forum, tout autant que tester bien des choses, j'ai encore trouvé un GROSSE optimisation de vitesse en désactivant provisoirement les Mise En Forme Conditionnelle ("MFC") :

'En début de macro
    
    For Each Worksheet In ThisWorkbook.Worksheets
    Worksheet.EnableFormatConditionsCalculation = False
    Next


'En fin de macro
    For Each Worksheet In ThisWorkbook.Worksheets
    Worksheet.EnableFormatConditionsCalculation = True
    Next