Supprimer les doublons

[chanu]

Bonjours à tous,
j'ai un soucis avec ce code, il me supprime les doublons de la ligne suivante alors que je veux cacher ceux de toute la colonne. Je ne vois pas l'astuce...😕

Private Sub UserForm_Initialize()

Dim Lig As Long
Dim Col As String
Dim ValeurCourante As String
Dim ValeurPrécédente As String

Lig = 1
Col = "A"
ValeurPrécédente = ""
ValeurCourante = Cells(Lig, Col).Value
Do While ValeurCourante <> ""
If ValeurCourante <> ValeurPrécédente Then
ListBox1.AddItem ValeurCourante
End If
Lig = Lig + 1
ValeurPrécédente = ValeurCourante
ValeurCourante = Cells(Lig, Col).Value
Loop
End Sub


Si quelqu'un pouvait me dire la solution merci...😀

 

[skoobi]

Re : Supprimer les doublons

Bonjour chanu,

pour supprimer les doublons, jette un œil à ma signature, ça devrait t'intéresser...
Bonne soirée.

 

[Catrice]

Re : Supprimer les doublons

Bonsoir,

Un exemple parmi d'autres :

Sub Test()
Columns(3).Clear
Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("C1"), Unique:=True
End Sub

Voir le fichier joint

 

[chanu]

Re : Supprimer les doublons

Nikel je vous remercie, je vais tester ça de suite 😉

 

[chanu]

Re : Supprimer les doublons

En fait ce que je voudrais c'est masquer les doublons dans une liste
J'ai une listeBox.Rowsource qui comprend des doublons et je voudrais les masquer quand je fais apparaître ma listBox

Désolé skoobi je suis débutant et ton code est un peu compliqué pour moi.

Voilà mon code tout bidon
Private Sub UserForm_Initialize()

Sheets("Feuil2").Select
lstVille.RowSource = "b1:b25"

End Sub

 

[Catrice]

Re : Supprimer les doublons

Re,

Regarde la solution de Boisgontier dans ce fil :
https://www.excel-downloads.com/threads/listbox-sans-doublon.117114/

Il y a plein d'autres Fils qui traitent de ce sujet

 

[chanu]

Re : Supprimer les doublons

Parfait c'est ce qui me fallait 😉

Pendant que j'y suis il y a t il un moyen de classer les éléments de la listbox par ordre alphabétique?

 

[BOISGONTIER]

Re : Supprimer les doublons

Bonjour,

Private Sub UserForm_Initialize()
  Set MonDico = CreateObject("Scripting.Dictionary")
  For Each c In Range([A2], [A65000].End(xlUp))
     If Not MonDico.Exists(c.Value) Then MonDico.Add c.Value, c.Value
  Next c 
  temp = MonDico.items       ' le tableau temp() reçoit les éléments de MonDico
  Call Tri(temp, LBound(temp), UBound(temp))     ' tri 
  Me.ComboBox1.List = temp                              ' éléments dans combobox1
End Sub

Sub Tri(a, gauc, droi) ' Quick sort
  ref = a((gauc + droi) \ 2)
  g = gauc: d = droi
  Do
     Do While a(g) < ref: g = g + 1: Loop
     Do While ref < a(d): d = d - 1: Loop
     If g <= d Then
        temp = a(g): a(g) = a(d): a(d) = temp
        g = g + 1: d = d - 1
     End If
   Loop While g <= d
   If g < droi Then Call Tri(a, g, droi)
   If gauc < d Then Call Tri(a, gauc, d)
End Sub

Listes sans doublons triée

JB

 

[chanu]

Re : Supprimer les doublons

ça marche je te remercie😉)