Menus en cascade

Code postal/Ville

FormCodePostaux.xls

Private Sub UserForm_Initialize()
  Set MonDico = CreateObject("Scripting.Dictionary")
  temp = [codesPostaux] ' pour recherche rapide 0.14 s pour 20.000 éléments
  For i = 1 To UBound(temp, 1)
    If Not MonDico.Exists(temp(i, 1)) Then MonDico.Add temp(i, 1), temp(i, 1)
  Next i
  Me.ComboBox1.List = MonDico.items
End Sub

Private Sub ComboBox1_Change()
  d = Application.Match(Me.ComboBox1, [codesPostaux], 0)
  Me.ListBox1.Clear
  For i = d To d + Application.CountIf([codesPostaux], Me.ComboBox1) - 1
  Me.ListBox1.AddItem Range("villes")(i)
Next i
End Sub

Attention!
Les codes postaux sont saisis sous forme de texte
Format/Cellule/Nombre/Texte avant la saisie

Noms de champ dynamiques
CodesPostaux =DECALER($A$2;;;NBVAL($A:$A)-1)
Villes =DECALER($B$2;;;NBVAL($B:$B)-1)

Listes en cascade pays

On fait apparaître les produits du pays choisi. (ListeCascadePays.xls)

Private Sub ComboBox1_Change()
i = 0
Me.ListBox1.Clear
For Each c In Range([A2], [A65000].End(xlUp))
If c.Offset(0, 2) = Me.ComboBox1 Or Me.ComboBox1 = "*" Then
Me.ListBox1.AddItem
Me.ListBox1.List(i, 0) = c.Value
Me.ListBox1.List(i, 1) = c.Offset(0, 1).Value
Me.ListBox1.List(i, 2) = c.Offset(0, 2).Value
Me.ListBox1.List(i, 3) = c.Offset(0, 3).Value
i = i + 1
End If
Next c
End Sub

Private Sub UserForm_Initialize()
Set mondico = CreateObject("Scripting.Dictionary")
For Each c In Range([C2], [C65000].End(xlUp))
If Not mondico.Exists(c.Value) Then mondico.Add c.Value, c.Value
Next c
Me.ComboBox1.AddItem "*"
For Each i In mondico.items
Me.ComboBox1.AddItem i
Next
End Sub

Listes en cascade triées

Form_CascadeTrie.xls

Private Sub UserForm_Initialize()
  Set MonDico = CreateObject("Scripting.Dictionary")
  For Each c In Range([A2], [A65000].End(xlUp))
    If Not MonDico.Exists(c.Value) Then MonDico.Add c.Value, c.Value
  Next c
  temp = MonDico.items
  Call Tri(temp, LBound(temp), UBound(temp)) ' voir module mod_tri
  Me.ComboBox1.List = temp
End Sub

Private Sub ComboBox1_Change()
  Set MonDico = CreateObject("Scripting.Dictionary")
  For Each c In Range([A2], [A65000].End(xlUp))
    If c = Me.ComboBox1 Then
      If Not MonDico.Exists(c.Offset(0, 1).Value) Then
        MonDico.Add c.Offset(0, 1).Value, c.Offset(0, 1).Value
      End If
    End If
  Next c
  temp = MonDico.items
  Call Tri(temp, LBound(temp), UBound(temp))
  Me.ListBox1.List = temp
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