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 : Sélectionner tout - Visualiser dans une fenêtre à part
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