ComboBox qui change de liste déroulante en fonction d'autre ComboBox

Le 28/05/2021 à 09:53

Bonjour à tous,

J'ai un petit soucis de codage.

J'aimerais que la ComboBox2 change de liste déroulante en fonction de l'état de la ComboBox1.

Voici mon code:

Private Sub UserForm_Initialize()
Set f = Sheets("Base")
  Set MonDico = CreateObject("Scripting.Dictionary")
  a = f.Range("C6:C" & f.[C1500].End(xlUp).Row) 
  For i = LBound(a) To UBound(a)
    If a(i, 1) <> "" Then MonDico(a(i, 1)) = ""
  Next i
  Me.ComboBox1.List = MonDico.keys

Set f = Sheets("Base")
  Set MonDico = CreateObject("Scripting.Dictionary")
  a = f.Range("D6:D" & f.[D1500].End(xlUp).Row) 
  For i = LBound(a) To UBound(a)
    If a(i, 1) <> "" Then MonDico(a(i, 1)) = ""
  Next i
  Me.ComboBox2.List = MonDico.keys

If ComboBox1.Value <> "" Then
Set f = Sheets("Filtrage")
    Set MonDico = CreateObject("Scripting.Dictionary")
  a = f.Range("N7:N" & f.[N1500].End(xlUp).Row) 
  For i = LBound(a) To UBound(a)
    If a(i, 1) <> "" Then MonDico(a(i, 1)) = ""
  Next i
  Me.ComboBox2.List = MonDico.keys
End If

End Sub

Merci d'avance les amis.

Le 28/05/2021 à 10:27

C'est bon mon problème est résolu ;)

Le 28/05/2021 à 12:05

Bonjour

Je me permet une petite amélioration (déclaration de variables et quelques ajustements). Peux-tu me montrer comment tu as fait au final ?

De plus, pas besoin de fair un Set à chaque fois, une fois en début de code suffis 

Private Sub UserForm_Initialize()
Dim f As Worksheet
Dim MonDico As Object
Dim Col As String
Dim PremLig As Long, DernLig As Long, i As Long
Dim Plage() As Variant

    Set f = ThisWorkbook.Worksheets("Base")
    Set MonDico = CreateObject("Scripting.Dictionary")
    Col = "C"
    PremLig = 6
    DernLig = f.Range(Col & f.Rows.Count).End(xlUp).Row
    Plage = f.Range(Col & PremLig & ":" & Col & DernLig).Value
    If PremLig > DernLig Then Exit Sub
    For i = LBound(Plage) To UBound(Plage)
        If Plage(i, 1) <> "" Then MonDico(Plage(i, 1)) = ""
    Next i
    Me.ComboBox1.List = MonDico.keys
End Sub

Une autre variante de code, celle-ci est plus fiable :

Private Sub UserForm_Initialize()
Dim f As Worksheet
Dim MonDico As Object
Dim Col As String
Dim PremLig As Long, DernLig As Long, i As Long
Dim Plage As Range
Dim Cel As Variant

    Col = "C" 'A ajuster
    PremLig = 6 'A ajuster

    Set f = ThisWorkbook.Worksheets("Feuil1")
    Set MonDico = CreateObject("Scripting.Dictionary")
    DernLig = f.Range(Col & f.Rows.Count).End(xlUp).Row 'Dernière cellule non-vide d'une colonne
    Set Plage = f.Range(Col & PremLig & ":" & Col & DernLig)
    For i = PremLig To DernLig
        Cel = Plage(i, 1).Value
        If Cel <> "" Then MonDico(Cel) = ""
    Next i
    Me.ComboBox1.List = MonDico.keys
End Sub
Le 28/05/2021 à 13:12

Voici mon code final:

Private Sub UserForm_Initialize()
Set f = Sheets("Base")
  Set MonDico = CreateObject("Scripting.Dictionary")
  a = f.Range("E6:E" & f.[E1500].End(xlUp).Row) ' tableau a(n,1) pour rapidité
  For i = LBound(a) To UBound(a)
    If a(i, 1) <> "" Then MonDico(a(i, 1)) = ""
  Next i
  Me.ComboBox1.List = MonDico.keys

Set f = Sheets("Base")
  Set MonDico = CreateObject("Scripting.Dictionary")
  a = f.Range("D6:D" & f.[D1500].End(xlUp).Row) ' tableau a(n,1) pour rapidité
  For i = LBound(a) To UBound(a)
    If a(i, 1) <> "" Then MonDico(a(i, 1)) = ""
  Next i
  Me.ComboBox2.List = MonDico.keys

Set f = Sheets("Base")
  Set MonDico = CreateObject("Scripting.Dictionary")
  a = f.Range("C6:C" & f.[C1500].End(xlUp).Row) ' tableau a(n,1) pour rapidité
  For i = LBound(a) To UBound(a)
    If a(i, 1) <> "" Then MonDico(a(i, 1)) = ""
  Next i
  Me.ComboBox3.List = MonDico.keys

End Sub

Private Sub ComboBox1_Click()
With Sheets("Filtrage")
.Range("B2") = ComboBox1.Value
If .Range("AF4").Value = 1 Then
Set f = Sheets("Filtrage")
    Set MonDico = CreateObject("Scripting.Dictionary")
  a = f.Range("AA7:AA" & f.[AA1500].End(xlUp).Row) ' tableau a(n,1) pour rapidité
  For i = LBound(a) To UBound(a)
    If a(i, 1) <> "" Then MonDico(a(i, 1)) = ""
  Next i
  Me.ComboBox2.List = MonDico.keys
Set f = Sheets("Filtrage")
    Set MonDico = CreateObject("Scripting.Dictionary")
  a = f.Range("Z7:Z" & f.[Z1500].End(xlUp).Row) ' tableau a(n,1) pour rapidité
  For i = LBound(a) To UBound(a)
    If a(i, 1) <> "" Then MonDico(a(i, 1)) = ""
  Next i
  Me.ComboBox3.List = MonDico.keys
  End If
End With

Bonne programmation.

Le 28/05/2021 à 14:55

Alors voilà, pour la partie UserForm_Initialize je me suis "amusé", je te laisse voir ce que j'ai fait Je vais te simplifier aussi la partie ComboBox1_Click. Je t'invite à regarder comment j'ai procédé et à te renseigner c'est comme ça que tu vas apprendre 

Private Sub UserForm_Initialize()
Dim f As Worksheet
Dim MonDico As Object
Dim Col As String
Dim Plage As Range
Dim i As Long, j As Long
Dim Data As Variant
Dim ListCol() As Variant, ListCombo() As Variant, ListPremLig() As Variant, ListDernLig() As Variant

    ListCombo = Array(1, 2, 3) 'A ajuster (Liste des ComboBox à remplir)
    ListCol = Array("E", "D", "C") 'A ajuster (Liste des colonnes de référence pour les ComboBox)
    ListPremLig = Array(6, 6, 6) 'A ajuster (Liste des premières lignes dans les colonnes)

    'A partir de là, plus besoin de toucher, tout est automatique !
    '=======================================================================================================
    Set f = ThisWorkbook.Worksheets("Base")
    Set MonDico = CreateObject("Scripting.Dictionary")
    ReDim ListDernLig(0 To UBound(ListPremLig))
    For i = LBound(ListCol) To UBound(ListCol)
        ListDernLig(i) = f.Range(ListCol(i) & f.Rows.Count).End(xlUp).Row
    Next i
    For i = LBound(ListCombo) To UBound(ListCombo)
        If ListDernLig(i) >= ListPremLig(i) Then
            Set Plage = f.Range(ListCol(i) & ListPremLig(i) & ":" & ListCol(i) & ListDernLig(i))
            For j = 1 To Plage.Rows.Count
                Data = Plage(j, 1).Value
                If Data <> "" Then MonDico(Data) = ""
            Next j
        End If
        Me.Controls("ComboBox" & ListCombo(i)).List = MonDico.Keys
        Set Plage = Nothing
        MonDico.RemoveAll
    Next i
    '=======================================================================================================
End Sub
Le 28/05/2021 à 15:11

Autant faire d'une pierre dux coup Dit moi ce que tu en pense ?!

Option Explicit
Private Sub UserForm_Initialize()
Dim ParamA() As Variant, ParamB() As Variant, ParamC() As Variant

    ParamA = Array("E", "D", "C") 'A ajuster (Liste des colonnes de référence pour les ComboBox)
    ParamB = Array(1, 2, 3)  'A ajuster (Liste des ComboBox à remplir)
    ParamC = Array(6, 6, 6) 'A ajuster (Liste des premières lignes dans les colonnes)
    Call ChargementComboBox("Base", ParamA, ParamB, ParamC)
End Sub

Private Sub ComboBox1_Click()
Dim f As Worksheet
Dim ParamA() As Variant, ParamB() As Variant, ParamC() As Variant

    Set f = ThisWorkbook.Worksheets("Filtrage")
    f.Range("B2") = ComboBox1.Value
    If f.Range("AF4").Value = 1 Then
        ParamA = Array("AA", "Z") 'A ajuster (Liste des colonnes de référence pour les ComboBox)
        ParamB = Array(2, 3) 'A ajuster (Liste des ComboBox à remplir)
        ParamC = Array(7, 7, 6) 'A ajuster (Liste des premières lignes dans les colonnes)
        Call ChargementComboBox(f.Name, ParamA, ParamB, ParamC)
    End If
End Sub

Private Function ChargementComboBox(FeuilleSource As String, ListCol() As Variant, ListCombo() As Variant, ListPremLig() As Variant)
Dim f As Worksheet
Dim MonDico As Object
Dim Col As String
Dim Plage As Range
Dim i As Long, j As Long
Dim Data As Variant
Dim ListDernLig() As Variant

    Set f = ThisWorkbook.Worksheets(FeuilleSource)
    Set MonDico = CreateObject("Scripting.Dictionary")
    ReDim ListDernLig(0 To UBound(ListPremLig))
    For i = LBound(ListCol) To UBound(ListCol)
        ListDernLig(i) = f.Range(ListCol(i) & f.Rows.Count).End(xlUp).Row
    Next i
    For i = LBound(ListCombo) To UBound(ListCombo)
        If ListDernLig(i) >= ListPremLig(i) Then
            Set Plage = f.Range(ListCol(i) & ListPremLig(i) & ":" & ListCol(i) & ListDernLig(i))
            For j = 1 To Plage.Rows.Count
                Data = Plage(j, 1).Value
                If Data <> "" Then MonDico(Data) = ""
            Next j
        End If
        Me.Controls("ComboBox" & ListCombo(i)).Clear
        Me.Controls("ComboBox" & ListCombo(i)).List = MonDico.Keys
        Set Plage = Nothing
        MonDico.RemoveAll
    Next i
End Function
Rechercher des sujets similaires à "combobox qui change liste deroulante fonction"