Suppression des doublons

[Trinity79]

Bonjour à tous,

J'aurais besoin d'un p'tit coup de pouce pour supprimer des doublons dans une colonne de données. Je sais qu'il existe une option dans Excel, mais je ne sais plus où elle se trouve.

Merci d'avance 😛

Trinity

 

[nat54]

Re : Suppression des doublons

Bonjour,

Tu n'as qu'une colonne avec doublons, ou il y a des colonnes à droite à supprimer aussi ?

si 1er cas, solution par macro

[FONT=Arial]Sub ENLEVER_DOUBLONS()[/FONT]
[FONT=Arial]ListeValUniques Range("A2:A5000"), Range("E1")   [/FONT][COLOR=teal][FONT=Arial]‘ on met la liste en colonne 1, la liste épurée se colle en colonne E[/FONT][/COLOR][FONT=Arial][/FONT]
[FONT=Arial]End Sub[/FONT]
[FONT=Arial] [/FONT]
[FONT=Arial]Sub ListeValUniques(PlageSrc As Range, CellDest As Range)[/FONT]
[COLOR=teal][FONT=Arial]'Extrait les valeurs uniques d'une colonne et les renvoie[/FONT][/COLOR]
[COLOR=teal][FONT=Arial]'dans une autre, à partir de CellDest[/FONT][/COLOR][FONT=Arial][/FONT]
[FONT=Arial]Dim Arr1, Elt, Arr2(), Coll As New Collection[/FONT]
[FONT=Arial] [/FONT]
[FONT=Arial]If PlageSrc.Columns.Count > 1 Then Exit Sub[/FONT]
[FONT=Arial]Arr1 = PlageSrc.Value[/FONT]
[FONT=Arial] [/FONT]
[FONT=Arial]For Each Elt In Arr1[/FONT]
[FONT=Arial]On Error Resume Next[/FONT]
[FONT=Arial]Coll.Add Elt, CStr(Elt)[/FONT]
[FONT=Arial]If Err.Number = 0 Then[/FONT]
[FONT=Arial]ReDim Preserve Arr2(1 To Coll.Count)[/FONT]
[FONT=Arial]Arr2(Coll.Count) = Elt[/FONT]
[FONT=Arial]End If[/FONT]
[FONT=Arial]On Error GoTo 0[/FONT]
[FONT=Arial]Next[/FONT]
[FONT=Arial] [/FONT]
[FONT=Arial]CellDest.Resize(Coll.Count).Value = _[/FONT]
[FONT=Arial]Application.Transpose(Arr2)[/FONT]
[FONT=Arial] [/FONT]
[FONT=Arial]End Sub[/FONT]

 

[Hervé]

Re : Suppression des doublons

bonjour trinity, nat

si tu veux supprimer directement les lignes :

Sub Bouton1_QuandClic()
Dim plage As Range
Dim i As Integer

Set plage = Range("a1:a" & Range("a65536").End(xlUp).Row)

For i = plage.Rows.Count To 1 Step -1
If Application.CountIf(plage, plage(i, 1)) > 1 Then
Rows(i).Delete
End If
Next i

End Sub

salut