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

Nicolas Lepauvre

XLDnaute Junior
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
 

Fichiers joints

Nicolas Lepauvre

XLDnaute Junior
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
 

Fichiers joints

Nicolas Lepauvre

XLDnaute Junior
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.
 

Fichiers joints

Nicolas Lepauvre

XLDnaute Junior
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
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
 

Fichiers joints

Nicolas Lepauvre

XLDnaute Junior
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
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
 

Fichiers joints

Nicolas Lepauvre

XLDnaute Junior
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
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.
 

Fichiers joints

Nicolas Lepauvre

XLDnaute Junior
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
Mille merci Nicole!
 

Discussions similaires


Haut Bas