doublons dans listbox suite choix combobox

[munity]

bonjour aux courageux du dimanche

j'ai cette petite procédure qui me permets d'alimenter une listbox en fonction du choix d'un combobox, le problème ce sont les doublons malheureusement
quelqu'un aurait il une solution car celle glanées sur le phorum ne fonctionne pas (je dois mal les appliquer)
merci d'avance
munity

Private Sub ComboBox1_Change()
Dim val As Variant, val2 As Variant
ListBox1.Clear
With Sheets("test")
Plg = .Range("a2:l" & .Range("A65536").End(xlUp).Row)
End With
For L = 1 To UBound(Plg, 1)
On Error Resume Next 'suite infos sur phorum mais ca marche pas snif If Plg(L, 3) = ComboBox1 Then
With ListBox1
.AddItem Plg(L, 5)
.List(.ListCount - 1, 1) = Plg(L, 6)
.List(.ListCount - 1, 2) = Plg(L, 7)
On Error Resume Next
End With
End If
Next L
ListBox1.BackColor = &HFFFFFF
ComboBox1.BackColor = &HFFFFFF
TextBox1 = ComboBox1.Value
End Sub

[Bebere]

bonjour Munity
pas testé ComboBox1_Change
IniComboBox1 pour alimenter sans doublons(adapter le nom de la feuille)


Private Sub ComboBox1_Change()
Dim Plg As Variant, L As Integer
ListBox1.Clear
With Sheets("test")
Plg = .Range("a2:l" & .Range("A65536").End(xlUp).Row)
End With
For L = 1 To UBound(Plg, 1)
'ne pas employer des mots clés ou des noms de fonctions comme variables
'pour du texte c'est bon,pour une date Cdate(ComboBox1.Value)
'pour du numérique Cdbl(ComboBox1.Value)ou Val(ComboBox1.Value)
If Plg(L, 3) = ComboBox1.Value Then
With ListBox1
.AddItem Plg(L, 5)
.List(.ListCount - 1, 1) = Plg(L, 6)
.List(.ListCount - 1, 2) = Plg(L, 7)
On Error Resume Next
End With
End If
Next L
ListBox1.BackColor = &HFFFFFF
ComboBox1.BackColor = &HFFFFFF
TextBox1.Value = ComboBox1.Value
End Sub
Private Sub IniComboBox1()
Dim Plg As Variant, ColD As Collection, Item As Variant, I As Integer

With Sheets("NomFeuille") 'à adapter
Plg = .Range("C2:C" & .Range("C65536").End(xlUp).Row)
End With
'une collection c'est sans doublons
Set ColD = New Collection

For I = 1 To UBound(Plg, 1)
On Error Resume Next
ColD.Add Plg(I, 1), CStr(Plg(I, 1))
On Error GoTo 0
Next I

ComboBox1.Clear

For Each Item In ColD
ComboBox1.AddItem Item
Next Item

Set ColD = Nothing


End Sub

à bientôt

[munity]

salut bebere

merci de ta réponse

cependant j'aurais souhaité s'il était possible gardé le code initial
avec seulement l'instruction permettant de supprimer les doublons
en effet avec ta methode la listbox ne se remplie que sur une seule colonne de plus la méthode change du combobox ne produit plus d'effet
ci dessous ton code adapté
Private Sub ComboBox1_Change()
Dim Plg As Variant, ColD As Collection, Item As Variant, I As Integer

ListBox1.Clear

With Sheets("test") 'à adapter
Plg = .Range("a2:l" & .Range("a65536").End(xlUp).Row)'j'ai augmenté la plage
End With
'une collection c'est sans doublons
Set ColD = New Collection
For I = 1 To UBound(Plg, 1)
On Error Resume Next
If Plg(L, 3) = ComboBox1 Then
ColD.Add Plg(I, 7), CStr(Plg(I, 7))
On Error GoTo 0
End If
Next I
For Each Item In ColD
ListBox1.AddItem Item'je charge la listbox
Next Item
Set ColD = Nothing
End Sub

[Bebere]

bonjour Munity
mets donc un bout de fichier avec ton problème
à bientôt

[munity]

salut bebere et le phorum

j'ai mis un peu de temps pour répondre en espérant qu'il n'est pas trop tard
voici le code qui me permet d'afficher les éléments dont j'ai besoin

Private Sub UserForm_Initialize()
Sheets("Liste Prestations - Clients").Select
If ActiveSheet.FilterMode = True Then ActiveSheet.ShowAllData
Dim Plg As Variant, L As Integer
ListBox1.Clear
With Sheets("Liste Prestations - Clients") 'à adapter
Plg = .Range("a2:l" & .Range("a65536").End(xlUp).Row)
End With
For L = 1 To UBound(Plg, 1)
With ListBox1
If Plg(L, 3) <> "Global" And Plg(L, 1) <> "DRH" Then
.AddItem Plg(L, 5)
.List(.ListCount - 1, 1) = Plg(L, 7)
End If
End With
Next L
End Sub

ou puis je mettre l'information pour éviter les doublons

merci de toutes réponses

munity

[munity]

resalut le phorum

n'y a t il pas une âme charitable afin de m'aider à compléter ce code avec les instructions permettant d'éliminer les doublons

snif
snif

munity

[jeanpierre]

Bonsoir munity, le Forum

Sans avoir la prétention de t'aider, il y a déjà beaucoup de solution sur le sujet, avec une petite recherche...

Sinon, tout en bas de ton fil, cinq sujets, plus ou moins adaptés à ta question....

Tu vois et tu reviens....

Bonne soirée avancée...

Jean-Pierre

[munity]

salut
merci de ta proposition
seulement les solutions proposées ne donnent pas la solution adaptée à mon besoin
en général pour éliminer les doublons le mieux est d'utiliser les collections seulement pour lorsque je mets à l'affichage 2 colonnes je ne parviens pas à avoir le résultat escompter
je m'y prendre mal
j'aurais juste besoin d'une ligne d'instruction permettant de supprimer les doublons quelque soit le nombre de colonne que je souhaite affichier dans ma listbox

merci d'avance

munity

[Bebere]

bonjour Munity,Jean-Pirre

essaye le code suivant que je n'ai pas testé
ce serait tout de même plus facile avec un fichier

Private Sub UserForm_Initialize()
Dim Plg As Variant, Tbl As Variant, I As Integer, L As Integer
Dim Col As Collection, Item As Variant

With Sheets("Liste Prestations - Clients")
If .FilterMode = True Then .ShowAllData
Plg = .Range("a2:l" & .Range("a65536").End(xlUp).Row)
End With

Set Col = New Collection

For L = 1 To UBound(Plg, 1)
If Plg(L, 3) <> "Global" And Plg(L, 1) <> "DRH" Then
On Error Resume Next
Col.Add Plg(L, 5), CStr(Plg(L, 5))
On Error GoTo 0
End If
Next L

ReDim Tbl(1 To Col.Count, 1 To 2)

L = 0
For Each Item In Col
L = L + 1: Tbl(L, 1) = Item
Next Item

Set Col = Nothing

For L = 1 To UBound(Plg, 1)
For I = 1 To UBound(Tbl, 1)
If Tbl(I, 1) = Plg(L, 5) Then
Tbl(I, 2) = Plg(L, 7)
End If
Next I
Next L

With ListBox1
.Clear
.List = Tbl
End With

End Sub
à bientôt

[munity]

salut bébére et le phorum

ta soluce semble fonctionner

je n'ai plus qu'a classer cette liste par ordre croissant et le triomphe sera complet

enfin je n'arrive pas à alléger le fichier pour qu'il ne fasse plus que 50 ko

merci encore

munity

[Bebere]

Munity,pour trier
tbl dans une feuille,tri croissant,tu le reprends,tu l'effaces

avant With Listbox1

with sheets("NomFeuilleChoisie")
.range("A1").resize(Ubound(Tbl,1),Ubound(Tbl,2))=t bl
.Range("A1:B" & .Range("A65536").end(xlup).row).Sort Key1:=.Range("A1"), Order1:=xlAscending, Header:=xlno, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

tbl=.Range("A1:B" & .Range("A65536").end(xlup).row)
.Range("A1:B" & .Range("A65536").end(xlup).row).clearcontents
end with

à bientôt
à bientôt