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

Loïc DUBOIS

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

Pièces jointes

  • test pour doublon .xlsx
    53.5 KB · Affichages: 16

vgendron

XLDnaute Barbatruc
avec ce code corrigé
VB:
Sub SupprimerDoublons()
'
' Macro1 Macro
Dim TabData() As Variant

With ActiveSheet

    LastLine = .UsedRange.Rows.Count 'dernière ligne non vide de la colonne A
    'LastCol = .UsedRange.Columns.Count
    Set ZoneATrier = .UsedRange 'toute la base de donnée avec ligne d'entete
    
    .Sort.SortFields.Clear 'on supprime tout tri eventuel
    .Sort.SortFields.Add Key:=Range("B2:B" & LastLine), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 'on trie sur la colonne B
    .Sort.SortFields.Add Key:=Range("D2:D" & LastLine), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 'on trie sur la colonne D
    .Sort.SortFields.Add Key:=Range("H2:H" & LastLine), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 'on trie sur la colonne H
    .Sort.SortFields.Add Key:=Range("L2:L" & LastLine), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 'on trie sur la colonne L
    .Sort.SortFields.Add Key:=Range("A2:A" & LastLine), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 'on trie sur la colonne A
    With .Sort 'on applique le tri
        .SetRange ZoneATrier
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
     
    TabData = .UsedRange.Value 'on met tout dans un tablo vba
    For i = UBound(TabData, 1) To LBound(TabData, 1) + 1 Step -1 'pour chaque ligne (hors entete)
        If TabData(i, 2) = TabData(i - 1, 2) And TabData(i, 3) = TabData(i - 1, 3) And TabData(i, 8) = TabData(i - 1, 8) And TabData(i, 12) = TabData(i - 1, 12) Then 'si on a un doublon
            For j = LBound(TabData, 2) To UBound(TabData, 2) 'on efface la ligne (le tri étant aussi sur la colonne A, celle qu'on efface est forcément postérieure
                TabData(i, j) = ""
            Next j
        End If
    Next i
    .UsedRange.Clear 'on efface la feuille
    .Range("A1").Resize(UBound(TabData, 1), UBound(TabData, 2)) = TabData 'on colle le tableau
    .Sort.SortFields.Clear 'on reapplique un tri sur la colonne B ==> les lignes vides se retrouvent en bas
    .Sort.SortFields.Add Key:=Range("B2:B" & LastLine), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
     With .Sort
        .SetRange ZoneATrier
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End With
End Sub
 

Loïc DUBOIS

XLDnaute Occasionnel
avec ce code corrigé
VB:
Sub SupprimerDoublons()
'
' Macro1 Macro
Dim TabData() As Variant

With ActiveSheet

    LastLine = .UsedRange.Rows.Count 'dernière ligne non vide de la colonne A
    'LastCol = .UsedRange.Columns.Count
    Set ZoneATrier = .UsedRange 'toute la base de donnée avec ligne d'entete
   
    .Sort.SortFields.Clear 'on supprime tout tri eventuel
    .Sort.SortFields.Add Key:=Range("B2:B" & LastLine), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 'on trie sur la colonne B
    .Sort.SortFields.Add Key:=Range("D2:D" & LastLine), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 'on trie sur la colonne D
    .Sort.SortFields.Add Key:=Range("H2:H" & LastLine), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 'on trie sur la colonne H
    .Sort.SortFields.Add Key:=Range("L2:L" & LastLine), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 'on trie sur la colonne L
    .Sort.SortFields.Add Key:=Range("A2:A" & LastLine), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 'on trie sur la colonne A
    With .Sort 'on applique le tri
        .SetRange ZoneATrier
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    TabData = .UsedRange.Value 'on met tout dans un tablo vba
    For i = UBound(TabData, 1) To LBound(TabData, 1) + 1 Step -1 'pour chaque ligne (hors entete)
        If TabData(i, 2) = TabData(i - 1, 2) And TabData(i, 3) = TabData(i - 1, 3) And TabData(i, 8) = TabData(i - 1, 8) And TabData(i, 12) = TabData(i - 1, 12) Then 'si on a un doublon
            For j = LBound(TabData, 2) To UBound(TabData, 2) 'on efface la ligne (le tri étant aussi sur la colonne A, celle qu'on efface est forcément postérieure
                TabData(i, j) = ""
            Next j
        End If
    Next i
    .UsedRange.Clear 'on efface la feuille
    .Range("A1").Resize(UBound(TabData, 1), UBound(TabData, 2)) = TabData 'on colle le tableau
    .Sort.SortFields.Clear 'on reapplique un tri sur la colonne B ==> les lignes vides se retrouvent en bas
    .Sort.SortFields.Add Key:=Range("B2:B" & LastLine), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
     With .Sort
        .SetRange ZoneATrier
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End With
End Sub
 

Loïc DUBOIS

XLDnaute Occasionnel
avec ce code corrigé
VB:
Sub SupprimerDoublons()
'
' Macro1 Macro
Dim TabData() As Variant

With ActiveSheet

    LastLine = .UsedRange.Rows.Count 'dernière ligne non vide de la colonne A
    'LastCol = .UsedRange.Columns.Count
    Set ZoneATrier = .UsedRange 'toute la base de donnée avec ligne d'entete
   
    .Sort.SortFields.Clear 'on supprime tout tri eventuel
    .Sort.SortFields.Add Key:=Range("B2:B" & LastLine), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 'on trie sur la colonne B
    .Sort.SortFields.Add Key:=Range("D2:D" & LastLine), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 'on trie sur la colonne D
    .Sort.SortFields.Add Key:=Range("H2:H" & LastLine), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 'on trie sur la colonne H
    .Sort.SortFields.Add Key:=Range("L2:L" & LastLine), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 'on trie sur la colonne L
    .Sort.SortFields.Add Key:=Range("A2:A" & LastLine), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 'on trie sur la colonne A
    With .Sort 'on applique le tri
        .SetRange ZoneATrier
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    TabData = .UsedRange.Value 'on met tout dans un tablo vba
    For i = UBound(TabData, 1) To LBound(TabData, 1) + 1 Step -1 'pour chaque ligne (hors entete)
        If TabData(i, 2) = TabData(i - 1, 2) And TabData(i, 3) = TabData(i - 1, 3) And TabData(i, 8) = TabData(i - 1, 8) And TabData(i, 12) = TabData(i - 1, 12) Then 'si on a un doublon
            For j = LBound(TabData, 2) To UBound(TabData, 2) 'on efface la ligne (le tri étant aussi sur la colonne A, celle qu'on efface est forcément postérieure
                TabData(i, j) = ""
            Next j
        End If
    Next i
    .UsedRange.Clear 'on efface la feuille
    .Range("A1").Resize(UBound(TabData, 1), UBound(TabData, 2)) = TabData 'on colle le tableau
    .Sort.SortFields.Clear 'on reapplique un tri sur la colonne B ==> les lignes vides se retrouvent en bas
    .Sort.SortFields.Add Key:=Range("B2:B" & LastLine), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
     With .Sort
        .SetRange ZoneATrier
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End With
End Sub
1654606550651.png

C'est un peu mieux, mais comme le montre l'image il en reste toujours 2 en trop. Il faudrait que le code puisse supprimer les deux lignes avec la date 26/02/2019 pour ne laisser seulement la ligne avec la date de 25/02/2019.

Merci beaucoup,
 

Amilo

XLDnaute Accro
Re,
Je vous joins ma proposition Power query testée sur le premier fichier de votre message #1 pour vérification,
Si le résultat correspond à vos attentes, je pourrai dans ce cas vous donner davantage d'explications

Cordialement
 

Pièces jointes

  • test amazon_V2.xlsx
    29.5 KB · Affichages: 4

Loïc DUBOIS

XLDnaute Occasionnel
Re,
Je vous joins ma proposition Power query testée sur le premier fichier de votre message #1 pour vérification,
Si le résultat correspond à vos attentes, je pourrai dans ce cas vous donner davantage d'explications

Cordialement
Re,

Oui avec cette exemple cela semble correspondre à 100% avec ce que je recherche. En revanche, est ce que cela fonctionnerait sur 21k lignes (j'estime qu'il y a environ 1k-2k doublons à supprimer) ?

Si oui, je veux bien vos explications et je vous en remercie d'avance.

Loïc
 

Amilo

XLDnaute Accro
Re,

Cela devrait fonctionner sans problème avec 21k lignes,
Si vos données sont amenées à évoluer en nombre de lignes, il vaut mieux convertir en un tableau structuré (comme dans ma proposition en message #8).

Sinon, si la plage reste fixe, il suffit de nommer la plage de 21k,
Ceci gardera la stucture originale du tableau.

Je vous ferai dans la journée, une explication en vidéo pour une meilleure compréhension

Cordialement
 

vgendron

XLDnaute Barbatruc
Je pense que si tu avais regardé le code et les commentaires, tu aurais vu que je faisais le test sur la colonne C au lieu de la colonne D
et il faut ajouter du usecase: parce que Director est différent de director
VB:
Sub SupprimerDoublons()
'
' Macro1 Macro
Dim TabData() As Variant

With ActiveSheet

    LastLine = .Range("A" & .Rows.Count).End(xlUp).Row 'UsedRange.Rows.Count 'dernière ligne non vide de la colonne A
    'LastCol = .UsedRange.Columns.Count
    Set ZoneATrier = .Range("A1:AW" & LastLine) 'toute la base de donnée avec ligne d'entete
    
    .Sort.SortFields.Clear 'on supprime tout tri eventuel
    .Sort.SortFields.Add Key:=Range("B2:B" & LastLine), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 'on trie sur la colonne B
    .Sort.SortFields.Add Key:=Range("D2:D" & LastLine), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 'on trie sur la colonne D
    .Sort.SortFields.Add Key:=Range("H2:H" & LastLine), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 'on trie sur la colonne H
    .Sort.SortFields.Add Key:=Range("L2:L" & LastLine), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 'on trie sur la colonne L
    .Sort.SortFields.Add Key:=Range("A2:A" & LastLine), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 'on trie sur la colonne A
    With .Sort 'on applique le tri
        .SetRange ZoneATrier
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
     
    TabData = ZoneATrier.Value 'on met tout dans un tablo vba
    For i = UBound(TabData, 1) To LBound(TabData, 1) + 1 Step -1 'pour chaque ligne (hors entete)
        If TabData(i, 2) = TabData(i - 1, 2) And UCase(TabData(i, 4)) = UCase(TabData(i - 1, 4)) And UCase(TabData(i, 8)) = UCase(TabData(i - 1, 8)) And UCase(TabData(i, 12)) = UCase(TabData(i - 1, 12)) Then 'si on a un doublon
            For j = LBound(TabData, 2) To UBound(TabData, 2) 'on efface la ligne (le tri étant aussi sur la colonne A, celle qu'on efface est forcément postérieure
                TabData(i, j) = ""
            Next j
        End If
    Next i
    .UsedRange.Clear 'on efface la feuille
    .Range("A1").Resize(UBound(TabData, 1), UBound(TabData, 2)) = TabData 'on colle le tableau
    .Sort.SortFields.Clear 'on reapplique un tri sur la colonne B ==> les lignes vides se retrouvent en bas
    .Sort.SortFields.Add Key:=Range("B2:B" & LastLine), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
     With .Sort
        .SetRange ZoneATrier
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End With
End Sub
 

Loïc DUBOIS

XLDnaute Occasionnel
Re,

Cela devrait fonctionner sans problème avec 21k lignes,
Si vos données sont amenées à évoluer en nombre de lignes, il vaut mieux convertir en un tableau structuré (comme dans ma proposition en message #8).

Sinon, si la plage reste fixe, il suffit de nommer la plage de 21k,
Ceci gardera la stucture originale du tableau.

Je vous ferai dans la journée, une explication en vidéo pour une meilleure compréhension

Cordialement
Super, merci beaucoup,

Loïc
 

Amilo

XLDnaute Accro
Re,
Désolé, je viens de me rendre compte que j'ai transmis 2 fois le même fichier,
Ci-joint le fichier avec les 90 lignes que je voulais vous transmettre dans le message # 19 pour vérification

Si cela correspond au résultat, je vous ferai un retour sur les explications

Cordialement
 

Pièces jointes

  • test pour doublon_V3 .xlsx
    105.6 KB · Affichages: 3

Loïc DUBOIS

XLDnaute Occasionnel
Je pense que si tu avais regardé le code et les commentaires, tu aurais vu que je faisais le test sur la colonne C au lieu de la colonne D
et il faut ajouter du usecase: parce que Director est différent de director
VB:
Sub SupprimerDoublons()
'
' Macro1 Macro
Dim TabData() As Variant

With ActiveSheet

    LastLine = .Range("A" & .Rows.Count).End(xlUp).Row 'UsedRange.Rows.Count 'dernière ligne non vide de la colonne A
    'LastCol = .UsedRange.Columns.Count
    Set ZoneATrier = .Range("A1:AW" & LastLine) 'toute la base de donnée avec ligne d'entete
   
    .Sort.SortFields.Clear 'on supprime tout tri eventuel
    .Sort.SortFields.Add Key:=Range("B2:B" & LastLine), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 'on trie sur la colonne B
    .Sort.SortFields.Add Key:=Range("D2:D" & LastLine), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 'on trie sur la colonne D
    .Sort.SortFields.Add Key:=Range("H2:H" & LastLine), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 'on trie sur la colonne H
    .Sort.SortFields.Add Key:=Range("L2:L" & LastLine), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 'on trie sur la colonne L
    .Sort.SortFields.Add Key:=Range("A2:A" & LastLine), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 'on trie sur la colonne A
    With .Sort 'on applique le tri
        .SetRange ZoneATrier
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    TabData = ZoneATrier.Value 'on met tout dans un tablo vba
    For i = UBound(TabData, 1) To LBound(TabData, 1) + 1 Step -1 'pour chaque ligne (hors entete)
        If TabData(i, 2) = TabData(i - 1, 2) And UCase(TabData(i, 4)) = UCase(TabData(i - 1, 4)) And UCase(TabData(i, 8)) = UCase(TabData(i - 1, 8)) And UCase(TabData(i, 12)) = UCase(TabData(i - 1, 12)) Then 'si on a un doublon
            For j = LBound(TabData, 2) To UBound(TabData, 2) 'on efface la ligne (le tri étant aussi sur la colonne A, celle qu'on efface est forcément postérieure
                TabData(i, j) = ""
            Next j
        End If
    Next i
    .UsedRange.Clear 'on efface la feuille
    .Range("A1").Resize(UBound(TabData, 1), UBound(TabData, 2)) = TabData 'on colle le tableau
    .Sort.SortFields.Clear 'on reapplique un tri sur la colonne B ==> les lignes vides se retrouvent en bas
    .Sort.SortFields.Add Key:=Range("B2:B" & LastLine), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
     With .Sort
        .SetRange ZoneATrier
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End With
End Sub
Super merci beaucoup pour le temps que vous m'avez accordez.

Loïc
 

Loïc DUBOIS

XLDnaute Occasionnel
Re,
Désolé, je viens de me rendre compte que j'ai transmis 2 fois le même fichier,
Ci-joint le fichier avec les 90 lignes que je voulais vous transmettre dans le message # 19 pour vérification

Si cela correspond au résultat, je vous ferai un retour sur les explications

Cordialement
C'est exactement le résultat attendu.

Je veux bien les explications qui je pense me sera utile pour ce projet ainsi que d'autres par la suite.

Merci d'avance.

Loïc
 

Amilo

XLDnaute Accro
Re,
@Loïc DUBOIS ,

Voici une démo qui sera automatiquement supprimée sous 7 jours,

J'ai considéré que la plage de votre fichier original reste figé à 21k et je n'ai donc pas transformé la plage en un tableau structuré,
Sinon, de mémoire le ruban Excel 2016 est légèrement différent de celui de la version Excel 2019 que j'ai utilisé mais cela ne devrait pas poser de souci pour les manipulations

A voir si le résultat est celui attendu...

Cordialement
 

Loïc DUBOIS

XLDnaute Occasionnel
Re,
@Loïc DUBOIS ,

Voici une démo qui sera automatiquement supprimée sous 7 jours,

J'ai considéré que la plage de votre fichier original reste figé à 21k et je n'ai donc pas transformé la plage en un tableau structuré,
Sinon, de mémoire le ruban Excel 2016 est légèrement différent de celui de la version Excel 2019 que j'ai utilisé mais cela ne devrait pas poser de souci pour les manipulations

A voir si le résultat est celui attendu...

Cordialement
Merci pour la vidéo.
Néammoins, je n'ai pas du tout le même ruban que vous. De ce fait je ne trouve pas la section "A partir de Tableau ou d'une plage" dans "données" (ci-joint mon ruban "données")
1654617334635.png
 

Discussions similaires

Réponses
26
Affichages
789

Statistiques des forums

Discussions
311 705
Messages
2 081 725
Membres
101 805
dernier inscrit
abrigy