XL 2016 Lenteur à l'insertion de ligne en VBA

Nicocotte125

XLDnaute Nouveau
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
 
Dernière édition:
Solution
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...

Nicocotte125

XLDnaute Nouveau
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

XLDnaute Nouveau
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

XLDnaute Nouveau
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") :

VB:
'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
 

Discussions similaires