Ne pas afficher doublon listbox multi sélection

  • Initiateur de la discussion Initiateur de la discussion vmax67
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

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
 
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
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
3
Affichages
66
Réponses
3
Affichages
612
  • Question Question
Microsoft 365 Export données
Réponses
4
Affichages
517
  • Question Question
Microsoft 365 worksheet_change
Réponses
29
Affichages
280
Retour