Ne pas afficher doublon listbox multi sélection

vmax67

XLDnaute Occasionnel
Bonjour

Une petite aide pour finaliser mon code ci-dessous.

Ma listbox fonctionne parfaitement mais m'affiche des doublons.

Comment faire !!


Dim t(), ta(), i As Long, m As Object, X As Long, k As Long, c As Byte, z As Byte, w, S As Worksheet

Private Sub UserForm_Initialize()

If Sheets("Saisie").Range("B3").Value = "DUNLOP 2" Then UserForm2.TextBox10.Value = "D2"
If Sheets("Saisie").Range("B3").Value = "DUNLOP 3" Then UserForm2.TextBox10.Value = "D3"

Set S = Sheets("Joueurs")
Set m = CreateObject("Scripting.Dictionary")

t = S.Range("b2:c" & S.Cells(Rows.Count, 1).End(xlUp).Row).SpecialCells(xlCellTypeVisible)
For i = 1 To UBound(t): m(t(i, 1)) = "": Next i

On Error Resume Next
X = 1
For i = 1 To UBound(t)
If t(i, 1) = TextBox10.Value Then
ReDim Preserve ta(1 To 6, 1 To X)
For k = 1 To 6
ta(k, X) = t(i, k)
Next k: X = X + 1: End If: Next i
lbx1.Column = ta

End Sub

Private Sub lbx1_Change()

On Error Resume Next
c = 0
For i = 0 To lbx1.ListCount - 1
If lbx1.Selected(i) Then c = c + 1
If c > 3 Then lbx1.Selected(lbx1.ListIndex) = 0
Next i
If lbx1.Selected(lbx1.ListIndex) = True Then
For w = 1 To 3
If Me("T" & w) = "" Then _
Me("T" & w) = lbx1.List(lbx1.ListIndex, 1): Me("T" & w + 3) = lbx1.List(lbx1.ListIndex, 2): Exit For
Next w
Else
For Each w In Array(T1, T2, T3)
If w.Value = lbx1.List(lbx1.ListIndex, 1) Or w.Value = lbx1.List(lbx1.ListIndex, 2) Then _
Me(w.Name) = ""
Next w
End If
End Sub

Par avance merci pour votre aide.

Vmax
 

Grand Chaman Excel

XLDnaute Impliqué
Re : Ne pas afficher doublon listbox multi sélection

Bonjour,

Voici une suggestion en modifiant légèrement le code:
VB:
Private Sub UserForm_Initialize()

    If Sheets("Saisie").Range("B3").Value = "DUNLOP 2" Then UserForm2.TextBox10.Value = "D2"
    If Sheets("Saisie").Range("B3").Value = "DUNLOP 3" Then UserForm2.TextBox10.Value = "D3"

    Set S = Sheets("Joueurs")
    Set m = CreateObject("Scripting.Dictionary")

    t = S.Range("b2:c" & S.Cells(Rows.Count, 1).End(xlUp).Row).SpecialCells(xlCellTypeVisible)

    On Error Resume Next
    X = 1
    For i = 1 To UBound(t)
        If t(i, 1) = TextBox10.Value And Not m.exists(t(i, 1)) Then
            m.Add t(i, 1), ""
            ReDim Preserve ta(1 To 6, 1 To X)
            For k = 1 To 6
                ta(k, X) = t(i, k)
            Next k
            X = X + 1
        End If
    Next i
    lbx1.Column = ta

End Sub
 

Discussions similaires

Réponses
4
Affichages
209
Réponses
11
Affichages
286

Statistiques des forums

Discussions
312 202
Messages
2 086 180
Membres
103 152
dernier inscrit
Karibu