Exécution de Macro qui dure 1 heure

Bonjour,

J'ai un fichier de 85000 lignes que je doit épuré. C'est le détail des lignes facturées par mois et par affaire. Une affaire peut avoir 10 lignes par facture comme 200 et je souhaite garder simplement les lignes de détail de la facture la plus récente et cela, pour chacune des affaires.
Donc j'ai trié mon fichier par affaire, puis Date du plus récent au plus ancien
J'ai écrit cette macro pour supprimer mes lignes. Mais voilà plus d'une heure que ça tourne te il me reste 30000 lignes.

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25

Sub SupDateInf() Dim Affaire As String, Dat As Date Dim I As Long, F As Long Worksheets(6).Select Affaire = Range("C1").Value Dat = Range("A1").Value F = Range("A100000").End(xlUp).Row For I = 1 To F If Range("C" & I).Value = "" Then 'Si pas de nom d'affaire on supprime la ligne Range("C" & I).EntireRow.Delete I = I - 1 'J'enlève 1 pour ne pas sauter de ligne suite à la suppression F = F - 1 'Pour lui éviter de tourner pour rien à la fin vu que j'aurai supprimé env 70000 lignes End If If Range("C" & I).Value = Affaire And Range("A" & I).Value < Dat Then ' Si C'est la même affaire mais une date inférieure on supprime Range("C" & I).EntireRow.Delete I = I - 1 F = F - 1 End If If Range("C" & I).Value <> Affaire Then ' Si c'est une nouvelle affaire Affaire = Range("C" & I).Value 'On redéfinit la variable Dat = Range("A" & I).Value 'idem pour la date MsgBox Affaire 'Juste pour m'aidé à suivre le déroulement End If Next I 'et on recommence End Sub

---

J'ai eu le temps de patienter, d'écrire ce post et j'en suis qu'à la lettre P

Merci pour votre aide

Bonjour Floyd,

Ouh là!

Pour supprimer des lignes, mieux vaut partir de la dernière avec un pas négatif de -1 jusqu'à la première.
C'est fondamental. Un contrôle par la fenêtre des variables locales l'illustrera bien vite.

D'autre part, mieux vaux utiliser la propriété SpecialCells (à vide) pour supprimer en 1 ligne de code toutes les lignes vides.

Ensuite, la suppression des lignes sera ainsi plus rapide en testant l'égalité des affaires. La feuille étant déjà triée par date.
Bien entendu, toujours en partant de la dernière ligne.

bonjour

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29

Sub SupDateInf() Dim Affaire As String, Dat As Date Dim I As Long, F As Long With Worksheets(6) .Select 'uniquement si tu veux voir et etre sur le sheets (6)(facultatif) Affaire = Range("C1").Value Dat = Range("A1").Value 'For I = 1 To F 'If Range("C" & I).Value = "" Then 'Si pas de nom d'affaire on supprime la ligne 'Range("C" & I).EntireRow.Delete ' I = I - 1 'J'enlève 1 pour ne pas sauter de ligne suite à la suppression ' F = F - 1 'Pour lui éviter de tourner pour rien à la fin vu que j'aurai supprimé env 70000 lignes 'End If '... '... .Range("A1", Cells(Rows.Count, "A").End(xlUp)).SpecialCells(xlCellTypeBlanks).EntireRow.Delete   F = .Range("A" & Rows.Count).End(xlUp).Row 'reste de ton code ' et je suis quasiment certain qu'avec les filtres on peut faire la deuxiemme suppression aussi en filtrant affaire en colonne "C" et la date en colonne "A" en field2 puis suppression du specialcells(xlvisible).entirerow '... '.... '....       End With   End Sub

---

Merci pour les aides.
En fait j'avais ça dans un onglet de classeur qui comprenait d'autres onglets liés et ça me recalculer automatiquement tout un tas de données. Bref très très lourd et ça a finit par planter.

J'ai refait ma macro en step -1 comme conseillé dans un classeur à part et ça fonctionne nettement mieux. Entre 2 et 8 mn

Merci

Bonjour Floyd,

Tu peux encore améliorer la performance de ton codr en gérant la propriété

Citation:

---

Calculation

---

de l'objet

Citation:

---

Application

---

comme expliqué ici.

Bonne continuation.