Macro pour faire un tri en cascade automatique sans formules avec des combobox

Bonjour le FORUM,
J’aimerais faire un tri en cascade automatique sans formules avec deux combobox sur la feuille <<choix>> et afficher le resultat sur cette même feuille comme le modèle s’y trouvant.
Dans la première combobox <<chercher selon>>, on devrait pouvoir choisir une catégorie. Dans la deuxième <<Recherche>>, on devrait pouvoir choisir un élément de cette catégorie.
L’affichage du résultat devrait se faire selon les exemples d’affichage sur les feuilles <<Affichage_Ex1>> et <<Affichage_Ex2>>. Il est important de remarquer que Paul et Julien n’ont pas le même nombre d’objet.
J’ai commencé à faire une macro. Je suis bloqué au niveau de la réalisation de cet affichage. En plus il y a beaucoup de vide dans mes combobox.
Je vous prie pour toute éventuelle aide.
Merci

Aucune réaction? Suis-je seul sur une île déserte comme Robinson Crusoe?

Nicolas Lepauvre à dit:

Aucune réaction? Suis-je seul sur une île déserte comme Robinson Crusoe?

Cliquez pour agrandir...

Au sécours! Au sécours! Au sécours!

Bonjour à tous
Je me suis débrouillé et j’ai pu faire ce que je souhaitais.
Cependant je fais face aux problèmes suivant :
La combobox1 (Chercher selon) comporte des vides entre les éléments de sa liste.
La combobox2 (Rechercher) quant à elle contient les entêtes du tableau de la feuille <<BD>> et des vides.
Comment pourrais-je procéder pour obtenir des comboboxs sans vides et sans entêtes?
Je vous remercie d’avance pour toute éventuelle aide.

BISSON Nicole à dit:

Bonsoir,
Bonsoir Nicole,
tout d'abord merci pour votre réponse.
J'ai apporté vos modifications à mon fichier. Il n'y a plus de vide dans la combobox1. Mais la combobox2 contient toujours des vides. En plus les deus combobox ne sont pas triés et elles devraient l'être.
Toute nouvelle aide serait la bienvenue.

Remplacer Selection_Change par GotFocus

Code:

Option Compare Text
Dim f, Rng
Private Sub ComboBox1_GotFocus()
   Set f = Sheets("bd")
   Set d = CreateObject("scripting.dictionary")
   Set Rng = f.Range("B1:N1")
   For Each c In Rng
     If c.Value <> "" Then d(c.Value) = ""
   Next c
   Me.ComboBox1.List = d.keys
End Sub

Private Sub ComboBox1_click()     ' choix de la colonne de recherche
  p = Application.Match(Me.ComboBox1, Rng, 0)
  Set Rng2 = f.[A3].Offset(, p).Resize(8)
  Me.ComboBox2.List = Rng2.Value
  Exit Sub
End Sub

Une organisation BD classique et un formulaire seraient sans doute +simple à gérer.

Bisson

Cliquez pour agrandir...

BISSON Nicole à dit:

Bonsoir,

Remplacer Selection_Change par GotFocus

Code:

Option Compare Text
Dim f, Rng
Private Sub ComboBox1_GotFocus()
   Set f = Sheets("bd")
   Set d = CreateObject("scripting.dictionary")
   Set Rng = f.Range("B1:N1")
   For Each c In Rng
     If c.Value <> "" Then d(c.Value) = ""
   Next c
   Me.ComboBox1.List = d.keys
End Sub

Private Sub ComboBox1_click()     ' choix de la colonne de recherche
  p = Application.Match(Me.ComboBox1, Rng, 0)
  Set Rng2 = f.[A3].Offset(, p).Resize(8)
  Me.ComboBox2.List = Rng2.Value
  Exit Sub
End Sub

Une organisation BD classique et un formulaire seraient sans doute +simple à gérer.

Bisson

Cliquez pour agrandir...

BISSON Nicole à dit:

Bonsoir,

Remplacer Selection_Change par GotFocus

Code:

Option Compare Text
Dim f, Rng
Private Sub ComboBox1_GotFocus()
   Set f = Sheets("bd")
   Set d = CreateObject("scripting.dictionary")
   Set Rng = f.Range("B1:N1")
   For Each c In Rng
     If c.Value <> "" Then d(c.Value) = ""
   Next c
   Me.ComboBox1.List = d.keys
End Sub

Private Sub ComboBox1_click()     ' choix de la colonne de recherche
  p = Application.Match(Me.ComboBox1, Rng, 0)
  Set Rng2 = f.[A3].Offset(, p).Resize(8)
  Me.ComboBox2.List = Rng2.Value
  Exit Sub
End Sub

Une organisation BD classique et un formulaire seraient sans doute +simple à gérer.

Bisson

Cliquez pour agrandir...

Bonsoir Nicole,
tout d'abord merci pour votre réponse.
J'ai apporté vos modifications à mon fichier. Il n'y a plus de vide dans la combobox1. Mais la combobox2 contient toujours des vides. En plus les deus combobox ne sont pas triées et elles devraient l'être.
Toute nouvelle aide serait la bienvenue.
Merci

BISSON Nicole à dit:

Bonjour,

Code:

Private Sub ComboBox1_click()     ' choix de la colonne de recherche
  p = Application.Match(Me.ComboBox1, Rng, 0)
  Set Rng2 = f.[A3].Offset(, p).Resize(8)
  Set d = CreateObject("scripting.dictionary")
  For Each c In Rng2
     If c.Value <> "" Then d(c.Value) = ""
  Next c
  Me.ComboBox2.List = d.keys
End Sub

Bisson

Cliquez pour agrandir...

Bonjour Nicole,
Encore énorme merci!
Les vides ont disparu dans les comboboxs.
Comment je fais maintenant pour trier (0-9; a-z) les éléments des comboboxs?
Merci.

BISSON Nicole à dit:

Code:

Option Compare Text
Dim f, Rng
Private Sub ComboBox1_GotFocus()
   Set f = Sheets("bd")
   Set d = CreateObject("scripting.dictionary")
   Set Rng = f.Range("B1:N1")
   For Each c In Rng
     If c.Value <> "" Then d(c.Value) = ""
   Next c
   Tbl = d.keys
   Tri Tbl, LBound(Tbl), UBound(Tbl)
   Me.ComboBox1.List = Tbl
End Sub

Private Sub ComboBox1_click()     ' choix de la colonne de recherche
  p = Application.Match(Me.ComboBox1, Rng, 0)
  Set Rng2 = f.[A3].Offset(, p).Resize(8)
  Set d = CreateObject("scripting.dictionary")
  For Each c In Rng2
     If c.Value <> "" Then d(c.Value) = ""
  Next c
  Tbl = d.keys
  Tri Tbl, LBound(Tbl), UBound(Tbl)
  Me.ComboBox2.List = Tbl
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 Tri a, g, droi
  If gauc < d Then Tri a, gauc, d
End Sub

Bisson

Cliquez pour agrandir...

Mille merci Nicole!