Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

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
218
Réponses
11
Affichages
305
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…