Lier deux combobox

Alors voilà.
Tu peux même oublier ton .AddItem pour la ComboBox1 et là tester dans cet état...

Option Explicit
Option Compare Text

Dim f As Worksheet, c As Range

'source : http://boisgontierjacques.free.fr/pages_site/Dictionnaire.htm#AlimenterListe
Private Sub UserForm_Initialize()
Dim temp(), dico As Object, dicoCombo2 As Object

  Set f = Sheets("Feuil1")
  Set dico = CreateObject("Scripting.Dictionary")
  For Each c In f.Range("D2:D" & f.[D65000].End(xlUp).Row)
     dico(c.Value) = ""
  Next c
  temp = dico.keys
  Call tri(temp, LBound(temp), UBound(temp))
  ComboBox1.Clear
  Me.ComboBox1.List = temp
End Sub

Private Sub ComboBox1_Change()
Dim temp(), dico As Object, dicoCombo2 As Object
  If ComboBox1 = "" Then Exit Sub
  Set f = Sheets("Feuil1")
  Set dico = CreateObject("Scripting.Dictionary")
  Set dicoCombo2 = CreateObject("Scripting.Dictionary")
  For Each c In f.Range("D2:D" & f.[D65000].End(xlUp).Row)
    If c.Value = ComboBox1 Then dicoCombo2(c.Offset(0, 3).Value) = ""
    If Not dico.exists(c.Offset(0, 1).Value) And c.Value = ComboBox1 Then
      dico(c.Offset(0, 1).Value) = ""
    End If
  Next c
  temp = dico.keys
  Call tri(temp, LBound(temp), UBound(temp))
  ComboBox9.Clear
  Me.ComboBox9.List = temp
  temp = dicoCombo2.keys
  Call tri(temp, LBound(temp), UBound(temp))
  ComboBox2.Clear
  Me.ComboBox2.List = temp
End Sub

Private Sub ComboBox9_Change()
Dim temp(), dico As Object, dicoCombo2 As Object
  If ComboBox9 = "" Then Exit Sub
  Set f = Sheets("Feuil1")
  Set dico = CreateObject("Scripting.Dictionary")
  Set dicoCombo2 = CreateObject("Scripting.Dictionary")
  For Each c In f.Range("D2:D" & f.[D65000].End(xlUp).Row)
    If c.Value = ComboBox1 And c.Offset(0, 1).Value = ComboBox9 Then dicoCombo2(c.Offset(0, 3).Value) = ""
    If Not dico.exists(c.Offset(0, 2).Value) And c.Value = ComboBox1 And c.Offset(0, 1).Value = ComboBox9 Then
      dico(c.Offset(0, 2).Value) = ""
    End If
  Next c
  temp = dico.keys
  Call tri(temp, LBound(temp), UBound(temp))
  ComboBox10.Clear
  Me.ComboBox10.List = temp
  temp = dicoCombo2.keys
  Call tri(temp, LBound(temp), UBound(temp))
  ComboBox2.Clear
  Me.ComboBox2.List = temp
End Sub

Private Sub combobox10_Change()
Dim dico As Object, dicoCombo2 As Object

'ComboBox10.Value = UCase(ComboBox10.Value)

Dim temp()
  If ComboBox10 = "" Then Exit Sub
  Set f = Sheets("Feuil1")
  Set dico = CreateObject("Scripting.Dictionary")
  Set dicoCombo2 = CreateObject("Scripting.Dictionary")
  For Each c In f.Range("D2:D" & f.[D65000].End(xlUp).Row)
    If Not dico.exists(c.Offset(0, 3).Value) And c.Value = ComboBox1 And c.Offset(0, 1).Value = ComboBox9 And c.Offset(0, 2).Value = ComboBox10 Then
      dico(c.Offset(0, 3).Value) = ""
    End If
  Next c
  temp = dico.keys
  Call tri(temp, LBound(temp), UBound(temp))
  ComboBox2.Clear
  Me.ComboBox2.List = temp
End Sub

Sub tri(a, gauc, droi) ' Quick sort
Dim ref, g, d, temp
  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,

A quoi sert une ComboBox qui n'affiche qu'une valeur?
Personnellement, j'utilise un label pour y mettre une seule donnée.
Voici le code :

Private Sub ComboBox1_Change()
Dim rngTrouve As Range

If ComboBox1 = "" Then Exit Sub
With Sheets("Feuil1") ' A ADAPTER : nom de la feuille contenant les données
    Set rngTrouve = .Columns(5).Cells.Find(ComboBox1, lookat:=xlWhole)
End With
'cas d'une combobox
If Not rngTrouve Is Nothing Then ComboBox2 = rngTrouve.Offset(0, 3)
'cas d'un label
If Not rngTrouve Is Nothing Then Label1.Caption = rngTrouve.Offset(0, 3)
End Sub

Effectivement si je n'avais qu'un seul choix ce serait un label.
Mais je n'ai jamais dit qu'il n'y a qu'un choix.

En effet dans la colonne E, j'ai plusieurs fois le même client (ou entreprise) et en colonne H des noms associer au client. D'ou le fait de vouloir afficher en fonction de la combobox1 toutes les personnes d'une entreprise :)

Je vais tester, Merci

Pijaku,

J'ai essayé d'adapter ton code à ma problématique (La combobox2 est alimenté par la colonne E et la combobox7 par la colonne H) mais la combobox7 reste vide après selection d'un client dans la combobox2. Pourrais-tu m'aider ?

Private Sub ComboBox7_Change()
Dim rngTrouve As Range
Dim Wks As Worksheet

        Set Wks = Sheets(NomUtilisateur)
        Sheets(NomUtilisateur).Activate

               With Sheets(NomUtilisateur)

        Set rngTrouve = .Columns(5).Cells.Find(ComboBox2, lookat:=xlWhole)

               End With

        If Not rngTrouve Is Nothing Then ComboBox7 = rngTrouve.Offset(0, 3)

End Sub

Merci

Bonjour Pijaku,

Petite incursion supplémentaire si cela est possible.

J'ai rajouté deux arborescences supplémentaires. La combobox2 (qui determine un choix d'entreprise) en colonne (E) permet un choix restreint sur la combobox3 colonne F (détermine la direction) et qui détermine un choix restreint sur la combobox4 colonne G (determine le bureau).

Bref, il s'agit de rajouter 2 niveaux mais de ne pas en tenir compte si aucun choix n'est effectué dans les combobox3 et combobox4. Ais-je été clair ?

remplace tout le code donné précédemment par celui-ci.
Il permet également le tri des trois combo........

Option Explicit
Option Compare Text

Dim f As Worksheet, c As Range, dico As Object

'source : http://boisgontierjacques.free.fr/pages_site/Dictionnaire.htm#AlimenterListe
Private Sub UserForm_Initialize()
Dim temp()

  Set f = Sheets("Feuil1")
  Set dico = CreateObject("Scripting.Dictionary")
  For Each c In f.Range("E2:E" & f.[E65000].End(xlUp).Row)
     dico(c.Value) = IIf(dico.exists(c.Value), dico(c.Value) & "*" & c.Offset(, -1), c.Offset(, -1))
  Next c
  temp = dico.keys
  Call tri(temp, LBound(temp), UBound(temp))
  ComboBox2.Clear
  Me.ComboBox2.List = temp
End Sub

Private Sub ComboBox2_Change()
Dim temp()
  If ComboBox2 = "" Then Exit Sub
  Set f = Sheets("Feuil1")
  Set dico = CreateObject("Scripting.Dictionary")
  For Each c In f.Range("E2:E" & f.[E65000].End(xlUp).Row)
    If Not dico.exists(c.Offset(0, 1).Value) And c.Value = ComboBox2 Then
      dico(c.Offset(0, 1).Value) = ""
    End If
  Next c
  temp = dico.keys
  Call tri(temp, LBound(temp), UBound(temp))
  ComboBox9.Clear
  Me.ComboBox9.List = temp
End Sub

Private Sub ComboBox9_Change()
Dim temp()
  If ComboBox9 = "" Then Exit Sub
  Set f = Sheets("Feuil1")
  Set dico = CreateObject("Scripting.Dictionary")
  For Each c In f.Range("E2:E" & f.[E65000].End(xlUp).Row)
    If Not dico.exists(c.Offset(0, 2).Value) And c.Value = ComboBox2 And c.Offset(0, 1).Value = ComboBox9 Then
      dico(c.Offset(0, 2).Value) = ""
    End If
  Next c
  temp = dico.keys
  Call tri(temp, LBound(temp), UBound(temp))
  ComboBox10.Clear
  Me.ComboBox10.List = temp
End Sub

Sub tri(a, gauc, droi) ' Quick sort
Dim ref, g, d, temp
  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

Puis-je totalement abusé ? Car pour adapter je m'en mêle les pinceaux, je pensais en effet que cela serait plus simple...

Tout le code donné précédemment m'est utile pour déterminer ma combobox7.

Option Compare Text
Dim f, dico
'source : http://boisgontierjacques.free.fr/pages_site/Dictionnaire.htm#AlimenterListe
Private Sub UserForm_Initialize()
  Set f = Sheets("Feuil1")
  Set dico = CreateObject("Scripting.Dictionary")
  For Each c In f.Range("E2:E" & f.[E65000].End(xlUp).Row)
     dico(c.Value) = IIf(dico.exists(c.Value), dico(c.Value) & "*" & c.Offset(, -1), c.Offset(, -1))
  Next c
  temp = dico.keys
  Call tri(temp, LBound(temp), UBound(temp))
  ComboBox2.Clear
  Me.ComboBox2.List = temp
End Sub

Private Sub ComboBox2_Change()
  If ComboBox2 = "" Then Exit Sub
  ComboBox7.Clear
  Set f = Sheets("Feuil1")
  For Each c In f.Range("E2:E" & f.[E65000].End(xlUp).Row)
    If c.Value = ComboBox2 Then ComboBox7.AddItem c.Offset(0, 3).Value
  Next c
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

A présent, et c'était mon 2ème message je souhaitais l'adapter pour de nouveaux besoins. Je me disais que je pourrais transformer sans problème mais ce n'est pas le cas...

En réalité j'ai trois niveaux d'arborescence : combobox1 (déterminé par additem), combobox9 (déterminé par le choix en combobox1 et prenant ses données en colonne E) et combobox10 (déterminé par le choix en combobox9 et prenant ses données en colonne F)
Tout cela permet de déterminer le choix dans la combobox2. Si tout va bien les possiblités sont faites en fonction du choix en combobox10. Si la combobox10 n'est pas rempli cela se fait en fonction de la combobox9. Et si la 9 n'est pas rempli, cela se fait en fonction de la combobox1.

Bref depuis tout à l'heure j'essaye d'adapter mais je plante... Peut être à cause du précédent code qui alimente la combobox2 à l'initialisation mais j'en ai besoin sinon pas de données...

Je sais que j'en demande beaucoup et je comprendrais que cette question reste sans suite. Mais par avance merci

J'ai rajouté un niveau c'est à dire combobox10_change() de la sorte :

Private Sub combobox10_Change()
ComboBox10.Value = UCase(ComboBox10.Value)

Dim temp()
  If ComboBox10 = "" Then Exit Sub
  Set wks = Sheets(NomUtilisateur)
  Set dico = CreateObject("Scripting.Dictionary")
  For Each c In wks.Range("D2:D" & wks.[D65000].End(xlUp).Row)
    If Not dico.exists(c.Offset(0, 3).Value) And c.Value = ComboBox1 And c.Offset(0, 2).Value = ComboBox10 Then
      dico(c.Offset(0, 3).Value) = ""
    End If
  Next c
  temp = dico.keys
'  Call tri(temp, LBound(temp), UBound(temp))
  ComboBox2.Clear
  Me.ComboBox2.List = temp
  
End Sub

Cela me permet d'avoir les choix en combobox2, le seul problème est que je n'ai pas de choix si la combobox9 et combobox10 sont vides...
Finalement c'est en désespérant que ca avance...

Mon seul problème dorénavant est d'avoir un choix même si la combobox9 et 10 ne sont pas rempli... J'espère que tu ne désespère pas...

Dans mon exemple, j'ai utilisé Combo 1, 9, 10 et 2 reliées respectivements aux colonnes A, B, C, D.
Cependant, la ligne : For Each c In f.Range("A2:A" & f.[A65000].End(xlUp).Row) n'est à changer que si ta Combo1 ne correspond pas à la colonne A. Pour faire varier les données des autres combo, tu dois chercher dans les Offset...

Option Explicit
Option Compare Text

Dim f As Worksheet, c As Range

'source : http://boisgontierjacques.free.fr/pages_site/Dictionnaire.htm#AlimenterListe
Private Sub UserForm_Initialize()
Dim temp(), dico As Object, dicoCombo2 As Object

  Set f = Sheets("Feuil1")
  Set dico = CreateObject("Scripting.Dictionary")
  For Each c In f.Range("A2:A" & f.[A65000].End(xlUp).Row)
     dico(c.Value) = ""
  Next c
  temp = dico.keys
  Call tri(temp, LBound(temp), UBound(temp))
  ComboBox1.Clear
  Me.ComboBox1.List = temp
End Sub

Private Sub ComboBox1_Change()
Dim temp(), dico As Object, dicoCombo2 As Object
  If ComboBox1 = "" Then Exit Sub
  Set f = Sheets("Feuil1")
  Set dico = CreateObject("Scripting.Dictionary")
  Set dicoCombo2 = CreateObject("Scripting.Dictionary")
  For Each c In f.Range("A1:A" & f.[A65000].End(xlUp).Row)
    If Not dico.exists(c.Offset(0, 1).Value) And c.Value = ComboBox1 Then
      dico(c.Offset(0, 1).Value) = ""
      dicoCombo2(c.Offset(0, 3).Value) = ""
    End If
  Next c
  temp = dico.keys
  Call tri(temp, LBound(temp), UBound(temp))
  ComboBox9.Clear
  Me.ComboBox9.List = temp
  temp = dicoCombo2.keys
  Call tri(temp, LBound(temp), UBound(temp))
  ComboBox2.Clear
  Me.ComboBox2.List = temp
End Sub

Private Sub ComboBox9_Change()
Dim temp(), dico As Object, dicoCombo2 As Object
  If ComboBox9 = "" Then Exit Sub
  Set f = Sheets("Feuil1")
  Set dico = CreateObject("Scripting.Dictionary")
  Set dicoCombo2 = CreateObject("Scripting.Dictionary")
  For Each c In f.Range("A2:A" & f.[A65000].End(xlUp).Row)
    If Not dico.exists(c.Offset(0, 2).Value) And c.Value = ComboBox1 And c.Offset(0, 1).Value = ComboBox9 Then
      dico(c.Offset(0, 2).Value) = ""
      dicoCombo2(c.Offset(0, 3).Value) = ""
    End If
  Next c
  temp = dico.keys
  Call tri(temp, LBound(temp), UBound(temp))
  ComboBox10.Clear
  Me.ComboBox10.List = temp
  temp = dicoCombo2.keys
  Call tri(temp, LBound(temp), UBound(temp))
  ComboBox2.Clear
  Me.ComboBox2.List = temp
End Sub

Private Sub combobox10_Change()
Dim dico As Object, dicoCombo2 As Object

'ComboBox10.Value = UCase(ComboBox10.Value)

Dim temp()
  If ComboBox10 = "" Then Exit Sub
  Set f = Sheets("Feuil1")
  Set dico = CreateObject("Scripting.Dictionary")
  Set dicoCombo2 = CreateObject("Scripting.Dictionary")
  For Each c In f.Range("A2:A" & f.[A65000].End(xlUp).Row)
    If Not dico.exists(c.Offset(0, 3).Value) And c.Value = ComboBox1 And c.Offset(0, 1).Value = ComboBox9 And c.Offset(0, 2).Value = ComboBox10 Then
      dico(c.Offset(0, 3).Value) = ""
    End If
  Next c
  temp = dico.keys
  'Call tri(temp, LBound(temp), UBound(temp))
  ComboBox2.Clear
  Me.ComboBox2.List = temp
End Sub

Sub tri(a, gauc, droi) ' Quick sort
Dim ref, g, d, temp
  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 Pijaku,

J'ai un petit soucis, surement tout con mais... j'y arrive pas.
Ma combo7 est alimenté par les éléments en colonne AC mais aussi par les éléments de la colonne G d'où mon souci...

 
Private Sub UserForm_activate()
Dim temp()
    Set wks = Sheets(NomUtilisateur)
   Set dico = CreateObject("Scripting.Dictionary")

'Combo2
  For Each c In wks.Range("G2:G" & wks.[G65000].End(xlUp).Row)
   dico(c.Value) = IIf(dico.exists(c.Value), dico(c.Value) & "*" & c.Offset(, -1), c.Offset(, -1))
 Next c
 temp = dico.keys
'  Call tri(temp, LBound(temp), UBound(temp))
 ComboBox2.Clear
 Me.ComboBox2.List = temp
End sub

Private Sub ComboBox2_Change()

'Majuscule Oblige
ComboBox2.Value = UCase(ComboBox2.Value)

Dim temp1()

If ComboBox2 = "" Then Exit Sub
ComboBox7.Clear

        Set wks = Sheets(NomUtilisateur)
  For Each c In wks.Range("G2:G" & wks.[G65000].End(xlUp).Row)
       'If c.Value = ComboBox2 Then ComboBox7.AddItem c.Offset(0, 22).Value
       
       If Not dico.exists(c.Offset(0, 22).Value) And c.Value = ComboBox2 Then
      dico(c.Offset(0, 22).Value) = ""
      End If
       Next c
      temp1 = dico.keys
      ComboBox7.Clear
      Me.ComboBox7.List = temp1
  
End Sub

Par avance merci

Bonjour,
Avec un exemple cela va tout de suite beaucoup mieux.
Ton erreur est de déclarer le dictionary en variable valide pour tout le module. Tu as placé en tête de module :

Dim temp(), c As Range, dico As Object, f As Worksheet 

Pourquoi pas, mais si tu ne recrées pas un dico par Sub, il va conserver les valeurs que tu y mets dans les Sub précédentes.
Dans ton exemple, la Sub UserForm_Initialise remplit le dico des valeurs contenues colonne G. Puis, au changement de valeur dans la combo2, tu essaie de remplit avec les valeurs de la colonne AC. Mais, comme tu ne recrées pas un nouvel objet, VBA complète le dico avec les nouvelles valeurs, mais conserve les anciennes...
D'où ton erreur.
Donc, à chaque nouvelle procédure, ajoute cette ligne :

Set dico = CreateObject("Scripting.Dictionary")

Ce qui aura pour effet de créer un nouvel objet dictionnaire par Sub...