Suppression d'un premier doublon à partir d'une clef.

HelioM

XLDnaute Nouveau
Bonjour,

J'ai un problème de suppression de doublons. J'ai vu que plusieurs sujets sur les doublons ont déjà été posté mais je ne pense pas avoir vu un cas identique au mien.

Je dispose d'un tableau de plusieurs colonnes (12). Je n'utilise que les 3 premières colonnes pour détecter des doublons. Donc si deux lignes ont leurs trois premieres cellules identiques elles sont considérées comme des doublons.

Cependant ce ne sont pas de réelles doublons car à part les trois premieres cellules elles peuvent avoir d'autres cellules différentes...

Mon tableau est trié et deux lignes considérées comme doublons sont forcément à la suite.

Ce que je voudrais c'est pouvoir supprimer la premiere ligne en doublon et pas la seconde.

Par exemple si j'utilise l'outil de suppression de doublons d'excel il me supprimera automatiquement la seconde ligne en doublon et pas la première, or je veux justement supprimer la premiere ligne doublon et conserver la seconde.

J'ai essayé de faire une macro (ci-dessous) mais étant complétement débutant elle ne marche pas .

Sub suppr_doublons()
Sheets("Base de Données").Select
For i = 1 To Range("Tableau112").Rows.Count - 1 Step 1
If Range("Tableau112").[SumProduct(($A$1:$A&"i"=$A&"i+1")*($B$1:$B&"i"=$B&"i+1")*($C$1:$C&"i"=$C&"i+1")*($A&"i+1"<>"") )] > 1 _
Then Range("Tableau112").Cells(i - 1, 1).EntireRow.Delete
Next i
End Sub


J'ai voulu utiliser sumproduct pour détecter les doublons et cells(i-1,1).entirerow.delete pour supprimer le premier doublon.

Je crois que c'est surtout mon "if" qui ne marche pas du tout.

D'avance merci pour tout éclaircissement !
 

Softmama

XLDnaute Accro
Re : Suppression d'un premier doublon à partir d'une clef.

Bonjour,

Tu peux utiliser ce code. A adapter si tes cellules à tester ne sont pas en colonnes A, B, C de ta feuille :

VB:
Sub doublons()
Dim PasDoublon As New Collection
On Error Resume Next
Set A = Range([A1], [A65536].End(xlUp)) 'Adapter la colonne de la première des 3 cellules
For j = 1 To A.Count
    PasDoublon.Add A.Cells(j) & A.Cells(j)(1, 2) & A.Cells(j)(1, 3), UCase(CStr(A.Cells(j) & A.Cells(j)(1, 2) & A.Cells(j)(1, 3)))
    If Err <> 0 Then
        Err.Clear
        PasDoublon.Add "FoEffacerLigne"
    End If
Next j
For t = PasDoublon.Count To 1 Step -1
    If PasDoublon(t) = "FoEffacerLigne" Then
        Range(A.Cells(t), A.Cells(t).Offset(0, 2)).Interior.ColorIndex = 22
        'Mettre la ligne ci-dessous au lieu de celle ci-dessus
        ' Pour effacer les doublons au lieu de les colorier en rouge
        'A.Cells(t).entirerow.delete
    End If
Next
On Error GoTo 0
End Sub

Ci joint un fichier d'exemple...
 
Dernière édition:

HelioM

XLDnaute Nouveau
Re : Suppression d'un premier doublon à partir d'une clef.

Bonsoir ,

Softmama, bravo et merci pour la réactivité !

Par contre la macro ne correspond pas vraiment à ce que je cherche car (comme son titre l'indique) elle supprime le second doublon alors que justement je souhaite supprimer le premier....

J'envoie donc un fichier d'exemple pour que ce soit plus clair. Sur la feuille 1 il y a un tableau qui symbolise exactement mon fichier et j'ai surligné en rouge les lignes que je souhaiterais supprimer.

En fait , comme on le voit , les doublons sont définis par les trois premières colonnes. Les doublons se suivent toujours et je voudrais supprimer à chaque fois le 1er doublon (et conserver le second....).

Je ne suis vraiment pas un expert en macro mais j'insiste sur le fait que j'utilise un tableau et je suppose que dans la macro et il est certainement plus efficace de travailler avec le nom du tableau , donc sur les lignes du tableau. Je précise cela car j'ai l'impression que ton code (Softmama) balaye toutes les lignes de la feuille excel (à cause du A65536....) bref ça n'a peut-être rien à voir mais bon...

J'espère que c'est plus clair, j'aurais dû envoyer un exemple tout de suite !


Merci pour votre aide !
 

Pièces jointes

  • Supprimer_1er_doublon.xls
    36.5 KB · Affichages: 128

Discussions similaires

Réponses
8
Affichages
620