Redondance/doublons dans Combobox

Bonjour,

J'ai un petit problème avec mes combobox.

Je m'explique, lorsque que je sélectionne une valeur dans ma combobox1, un tri est effectué dans ma combobox2 pour afficher uniquement les éléments en lien avec la combobox1.

C'est a ce moment la que mon problème apparaît, c'est-à-dire que j'ai plusieurs fois le même terme qui apparaît.

J'aurai besoin d'aide pour résoudre ce problème.

Merci

25classeur1-v1.xlsm (19.44 Ko)

Bonsoir,

Private Sub UserForm_Initialize()
  Set f = Sheets("BD")
  Set d = CreateObject("Scripting.Dictionary")
  For Each c In f.Range("A2:A" & f.[A65000].End(xlUp).Row)
    d(c.Value) = ""
  Next c
  temp = d.keys
  Tri temp, LBound(temp), UBound(temp)
  Me.ComboBox1.List = temp
End Sub

Private Sub ComboBox1_click()
  Set d = CreateObject("Scripting.Dictionary")
  For Each c In f.Range("A2:A" & f.[A65000].End(xlUp).Row)
    If c.Value = Me.ComboBox1 Then d(c.Offset(, 1).Value) = ""
  Next c
  temp = d.keys
  Tri temp, LBound(temp), UBound(temp)
  Me.ComboBox2.List = temp
  Me.ComboBox2.ListIndex = -1
  Me.ComboBox3.ListIndex = -1
End Sub

Private Sub ComboBox2_click()
  Set d = CreateObject("Scripting.Dictionary")
    For Each c In f.Range("A2:A" & f.[A65000].End(xlUp).Row)
    If c.Value = Me.ComboBox1 And c.Offset(, 1).Value = Me.ComboBox2 Then d(c.Offset(, 2).Value) = ""
   Next c
   temp = d.keys
   Tri temp, LBound(temp), UBound(temp)
   Me.ComboBox3.List = temp
   Me.ComboBox3.ListIndex = -1
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

Boisgontier

Bonjour,

Merci pour votre retour.

J'ai essayé d'appliquer le code dans un autre fichier, mais j'ai une erreur qui apparaît " l'indice 9 n'appartient pas à la sélection ".

Pourriez-m'aider ?

Mon code de base avant de mettre votre code était le suivant :

Option Explicit

Dim strTemp, i&, j&, nCB&
Dim fd As Worksheet, tablo, dico As Object
Dim DerLigne As Integer

Private Sub ComboBox1_Change()
    ComboBox2.Clear
    ComboBox3.Clear
    ComboBox4.Clear

    For i = 1 To UBound(tablo, 1)
        If tablo(i, 1) = ComboBox1 Then
            ComboBox2.AddItem tablo(i, 2)
        End If
    Next i
    nCB = 2
    Call Tri
End Sub

Private Sub ComboBox2_Change()
    ComboBox3.Clear
    ComboBox4.Clear

    For i = 1 To UBound(tablo, 1)
        If tablo(i, 1) = ComboBox1 And tablo(i, 2) = ComboBox2 Then
            ComboBox3.AddItem tablo(i, 3)
        End If
    Next i
    nCB = 3
    Call Tri
End Sub
Private Sub ComboBox3_Change()
    ComboBox4.Clear

    For i = 1 To UBound(tablo, 1)
        If tablo(i, 1) = ComboBox1 And tablo(i, 3) = ComboBox3 Then
            ComboBox4.AddItem tablo(i, 4)
        End If
    Next i
    nCB = 4
    Call Tri
End Sub

Private Sub CommandButton1_Click()
If MsgBox("confirmez-vous l'ajout des données?", vbYesNo, "confirmation") = vbYes Then
With Worksheets("ENTREES_SORTIES")
DerLigne = .Range("A" & Rows.Count).End(xlUp).Row + 1

        Cells(DerLigne, "A") = ComboBox1
        Cells(DerLigne, "B") = ComboBox2
        Cells(DerLigne, "C") = ComboBox3
        Cells(DerLigne, "D") = ComboBox4
        Cells(DerLigne, "E") = TextBox2.Value
        Cells(DerLigne, "F") = TextBox3.Value
        Cells(DerLigne, "H") = ComboBox5
        Cells(DerLigne, "I") = ComboBox6
        Cells(DerLigne, "J") = TextBox4.Value

    End With
End If
End Sub

Private Sub CommandButton2_Click()
Unload Sorties
End Sub

Private Sub UserForm_initialize()
    Set fd = Sheets("ENTREES_SORTIES")
    Set dico = CreateObject("Scripting.Dictionary")

    tablo = fd.Range("A11:D" & fd.Range("A" & Rows.Count).End(xlUp).Row)
    For i = 1 To UBound(tablo, 1)
        dico(tablo(i, 1)) = ""
    Next i
    ComboBox1.List = Application.Transpose(dico.keys)

    nCB = 1
    Call Tri
End Sub
Sub Tri()
    With Me.Controls("ComboBox" & nCB)
        For i = 0 To .ListCount - 1
            For j = 0 To .ListCount - 1
                If .List(i) < .List(j) Then
                    strTemp = .List(i)
                    .List(i) = .List(j)
                    .List(j) = strTemp
                End If
            Next j
        Next i
    End With
End Sub

Cordialement

4stocks-v2.xlsm (247.19 Ko)

Bonjour à tous,

Dans ton code, tu écris dans Private Sub UserForm_initialize() du UserForm Sorties set f = Sheets("ENTREE_SORTIE") ... mais le nom de la feuille est ENTREES_SORTIES d'où l'erreur.

ric

Merci ric pour cette correction.

Mais du coup j'ai un autre problème qui ce situe ici

ref = a((gauc + droi) \ 2)

Le message d'erreur est le suivant : " l'indice 9 n'appartient pas à la sélection"

merci d'avance

Bonjour,

Tout en regardant ton code pour situer l'erreur, j'ai trouvé ceci ...

Si tu utilises un With ... il faut mettre des . devant les Cells et les Range si tu veux que les Cells et les Range soient ceux de la feuille référée par le With. Sinon, ce sera ceux de la feuille active.

Private Sub CommandButton1_Click()
If MsgBox("confirmez-vous l'ajout des données?", vbYesNo, "confirmation") = vbYes Then
With Worksheets("ENTREES_SORTIES")
DerLigne = .Range("A" & Rows.Count).End(xlUp).Row + 1
        .Cells(DerLigne, "A") = ComboBox1
        .Cells(DerLigne, "B") = ComboBox2
        .Cells(DerLigne, "C") = ComboBox3
        .Cells(DerLigne, "D") = ComboBox4
        .Cells(DerLigne, "E") = TextBox2.Value
        .Cells(DerLigne, "F") = TextBox3.Value
        .Cells(DerLigne, "H") = ComboBox5
        .Cells(DerLigne, "I") = ComboBox6
        .Cells(DerLigne, "J") = TextBox4.Value
    End With
End If
End Sub

ric

Bonjour à tous,

ref = a((gauc + droi) \ 2)

L'erreur est dans le code de la combobox3 ... le code réfère à la combobox3 elle même et il devrait référer à la combobox2 ... ainsi ...

Private Sub ComboBox3_click()
  Set d = CreateObject("Scripting.Dictionary")
    For Each c In f.Range("A11:A" & f.[A65000].End(xlUp).Row)
    If c.Value = Me.ComboBox1 And c.Offset(, 1).Value = Me.ComboBox2 Then d(c.Offset(, 3).Value) = ""
   Next c
   temp = d.keys
   Tri temp, LBound(temp), UBound(temp)
   Me.ComboBox4.List = temp
   Me.ComboBox4.ListIndex = -1
End Sub

ric

Bonjour,

Donc si je veux ajouter une combobox supplémentaire, le code sera le suivant :

Option Compare Text
Dim f
Dim DerLigne As Integer

Private Sub ComboBox1_click()
  Set d = CreateObject("Scripting.Dictionary")
  For Each c In f.Range("A11:A" & f.[A65000].End(xlUp).Row)
    If c.Value = Me.ComboBox1 Then d(c.Offset(, 1).Value) = ""
  Next c
  Temp = d.keys
  Tri Temp, LBound(Temp), UBound(Temp)
  Me.ComboBox2.List = Temp
  Me.ComboBox2.ListIndex = -1
  Me.ComboBox3.ListIndex = -1
  Me.ComboBox4.ListIndex = -1
  Me.ComboBox5.ListIndex = -1
End Sub

Private Sub ComboBox2_click()
  Set d = CreateObject("Scripting.Dictionary")
    For Each c In f.Range("A11:A" & f.[A65000].End(xlUp).Row)
    If c.Value = Me.ComboBox1 And c.Offset(, 1).Value = Me.ComboBox2 Then d(c.Offset(, 2).Value) = ""
   Next c
   Temp = d.keys
   Tri Temp, LBound(Temp), UBound(Temp)
   Me.ComboBox3.List = Temp
   Me.ComboBox3.ListIndex = -1
   Me.ComboBox4.ListIndex = -1
   Me.ComboBox5.ListIndex = -1
End Sub

Private Sub ComboBox3_click()
  Set d = CreateObject("Scripting.Dictionary")
    For Each c In f.Range("A11:A" & f.[A65000].End(xlUp).Row)
    If c.Value = Me.ComboBox1 And c.Offset(, 1).Value = Me.ComboBox3 Then d(c.Offset(, 3).Value) = ""
   Next c
   Temp = d.keys
   Tri Temp, LBound(Temp), UBound(Temp)
   Me.ComboBox4.List = Temp
   Me.ComboBox4.ListIndex = -1
   Me.ComboBox5.ListIndex = -1
End Sub

Private Sub ComboBox4_click()
  Set d = CreateObject("Scripting.Dictionary")
    For Each c In f.Range("A11:A" & f.[A65000].End(xlUp).Row)
    If c.Value = Me.ComboBox1 And c.Offset(, 1).Value = Me.ComboBox4 Then d(c.Offset(, 4).Value) = ""
   Next c
   Temp = d.keys
   Tri Temp, LBound(Temp), UBound(Temp)
   Me.ComboBox5.List = Temp
   Me.ComboBox5.ListIndex = -1
End Sub

Private Sub CommandButton1_Click()
If MsgBox("confirmez-vous l'ajout des données?", vbYesNo, "confirmation") = vbYes Then
With Worksheets("ENTREES_SORTIES")
DerLigne = .Range("A" & Rows.Count).End(xlUp).Row + 1

        .Cells(DerLigne, "A") = ComboBox1
        .Cells(DerLigne, "B") = ComboBox2
        .Cells(DerLigne, "C") = ComboBox3
        .Cells(DerLigne, "D") = ComboBox4
        .Cells(DerLigne, "E") = TextBox2.Value
        .Cells(DerLigne, "F") = TextBox3.Value
        .Cells(DerLigne, "H") = ComboBox5
        .Cells(DerLigne, "I") = ComboBox6
        .Cells(DerLigne, "J") = TextBox4.Value

    End With
End If
End Sub

Private Sub CommandButton2_Click()
Unload Sorties
End Sub

Private Sub UserForm_initialize()
Set f = Sheets("STOCKS")
  Set d = CreateObject("Scripting.Dictionary")
  For Each c In f.Range("A11:A" & f.[A65000].End(xlUp).Row)
    d(c.Value) = ""
  Next c
  Temp = d.keys
  Tri Temp, LBound(Temp), UBound(Temp)
  Me.ComboBox1.List = Temp
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

Bonjour,

En ajoutant une combox supplémentaire j'ai encore le message d'erreur qui s'affiche.

Si j'ai bien compris, le code devrait être celui-ci :

Private Sub ComboBox4_click()

    Set d = CreateObject("Scripting.Dictionary")
    For Each c In f.Range("A11:A" & f.[A65000].End(xlUp).Row)
        If c.Value = Me.ComboBox1 And c.Offset(, 3).Value = Me.ComboBox3 Then d(c.Offset(, 4).Value) = ""
    Next c
    Temp = d.keys
    Tri Temp, LBound(Temp), UBound(Temp)
    Me.ComboBox5.List = Temp
    Me.ComboBox5.ListIndex = -1

End Sub

Pourriez-vous m'aider à m'en sortir.

Merci d'avance

Bonjour,

Un essai ...

ric

Rechercher des sujets similaires à "redondance doublons combobox"