XL 2016 Supprimer les doublons (avec 4 colonnes) et ne garder que la ligne la plus ancienne (colonne A)

[Loïc DUBOIS]

Bonjour à tous,

J'ai besoin de faire une manipulation me permettant de supprimer les doublons selon 4 colonnes et ne garder que la ligne avec la date la plus ancienne.

Je m'explique, j'ai un fichier excel avec environ 21k lignes. Parmis ces lignes se trouve des doublons. Or je veux les supprimer en ne gardant que le doublon le plus ancien. Je caractérise les doublons sur plusieurs colonnes. Un doublon est avéré lorsque la colonne "Année" (B), "Personne" (D), "Fonction" (H), RIC (L).

Pour résumer, pouvez-vous m'aider à supprimer les doublons lorsque les 4 colonnes ci-dessus sont identiques et ne garder uniquement la ligne la plus ancienne (colonne A) ?

Je vous joint un fichier exemple : dans ce fichier j'ai des doublons avec "Amazon" (colonne B, D, H et L identiques mais je souhaite ne garder que la ligne avec la date la plus ancienne (colonne A).

Je vous remercie par avance,

Bien cordialement,

Loïc DUBOIS

 

[job75]

Sur MAC il faut remplacer le Dictionary par une collection, voyez ce fichier (2) :

Private Sub WorkSheet_Activate()
Dim tablo, ncol%, i&, x$, c As New Collection, n&, resu(), nn&, j%
With Sheets("Feuil1") 'à adapter
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    tablo = .Range("A1:AW" & .Range("A" & .Rows.Count).End(xlUp).Row)
End With
ncol = UBound(tablo, 2)
On Error Resume Next
For i = 2 To UBound(tablo)
    x = LCase(tablo(i, 2) & Chr(1) & tablo(i, 4) & Chr(1) & tablo(i, 8) & Chr(1) & tablo(i, 12))
    Err = 0
    c.Add i, x 'mémorise la ligne
    If Err Then If tablo(i, 1) < tablo(c(x), 1) Then c.Remove x: c.Add i, x  'teste la date
Next i
On Error GoTo 0
'---tableau des résultats---
n = c.Count
If n Then
    ReDim resu(1 To n, 1 To ncol)
    For i = 1 To n
        nn = c.Item(i)
        For j = 1 To ncol
            resu(i, j) = tablo(nn, j)
    Next j, i
End If
'---restitution---
If FilterMode Then ShowAllData 'si la feuille est filtrée
With [A2] '1ère cellule de restitution, à adapter
    If n Then .Resize(n, ncol) = resu
    .Offset(n).Resize(Rows.Count - n - .Row + 1, ncol).ClearContents 'RAZ en dessous
End With
Columns.AutoFit 'ajuste les largeurs
End Sub

L'exécution est nettement moins rapide qu'avec le Dictionary.

Bonne nuit.

 

[ChTi160]

Bonjour le fil
je me suis rendu Compte que je testais la Colonne "C" au lieu de "B" !
je n'ai pas compris d'ailleurs pourquoi comparer la Colonne "Année"(B) alors que la condition essentielle est : "ne garder uniquement la ligne la plus ancienne (colonne A) ?"(A)
A moins que l'année (B) puisse être différente de l'année de la date(A) !

Bonne journée
Jean marie