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

Nicolas Lepauvre à dit:

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

Cliquez pour agrandir...

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

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

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