Remplir une listbox en fonction de deux combobox en cascade

Option Compare Text
Dim TblBD(), NbCol, colThème, ColSThème
Private Sub UserForm_Initialize()
   Set f = Sheets("Base")
   TblBD = f.Range("A2:C" & f.[A65000].End(xlUp).Row).Value
   NbCol = UBound(TblBD, 2)
   colThème = 1: ColSThème = 2
   '--- combobox Thématique
   Set d = CreateObject("Scripting.Dictionary")
   d("*") = ""
   For I = LBound(TblBD) To UBound(TblBD)
    d(TblBD(I, colThème)) = ""
   Next I
   temp = d.keys
   Tri temp, LBound(temp), UBound(temp)
   Me.ComboBox1.List = temp
   Me.ComboBox1.ListIndex = 0
   Affiche
End Sub

Private Sub ComboBox1_click()
   '--- combobox sous thematique trié
   Set d = CreateObject("Scripting.Dictionary")
   d("*") = ""
   For I = LBound(TblBD) To UBound(TblBD)
    If TblBD(I, colThème) = Me.ComboBox1 Then d(TblBD(I, ColSThème)) = ""
   Next I
   temp = d.keys
   Tri temp, LBound(temp), UBound(temp)
   Me.ComboBox2.List = temp
   Me.ComboBox2.ListIndex = 0
   TriMult TblBD, LBound(TblBD), UBound(TblBD), 1
   Affiche
End Sub

Private Sub ComboBox2_click()
   Affiche
End Sub

Sub Affiche()
  Dim Tbl()
  themathique = Me.ComboBox1
  soustheme = Me.ComboBox2
  n = 0
  For I = 1 To UBound(TblBD)
    If TblBD(I, 1) Like themathique And TblBD(I, 2) Like soustheme Then
        n = n + 1: ReDim Preserve Tbl(1 To NbCol, 1 To n)
        For K = 1 To NbCol: Tbl(K, n) = TblBD(I, K): Next K
    End If
  Next I
  If n > 0 Then
     Me.ListBox1.Column = Tbl
     Me.Label3.Caption = Me.ListBox1.ListCount & " Ligne(s)"
  Else
     Me.ListBox1.Clear
     Me.Label3.Caption = ""
  End If
End Sub

Private O As Worksheet 'déclare la variable O (Onglet)
Private TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Private D As Object 'déclare la variable D (Dictionnaire)
Private I As Integer 'déclare la variable I (Incrément)

Private Sub UserForm_Initialize() 'à l'initialisation de l'UserForm
Me.ListBox1.ColumnCount = 3 'définit le nombre de colonnes de la ListBox1
Set O = Worksheets("Base") 'définit l'onglet O
TV = O.Range("A1").CurrentRegion 'définit le tableau des valeurs TV
Set D = CreateObject("Scripting.Dictionary") 'définit le dictionnaire D
For I = 2 To UBound(TV, 1) 'boucle sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
    D(TV(I, 1)) = "" 'alimente le dictionnaire D avec la données en colonne 1 du tableau des valeurs TV
Next I 'prochaine ligne de la boucle
Me.ComboBox1.List = D.keys 'alimente la ComboBox1 avec les données du dictionnaire D sans doublon
End Sub

Private Sub ComboBox1_Change() 'au changement de la Combobox1
Dim TL() As Variant 'déclare la variable TL (Tableau des Lignes)
Dim K As Integer 'déclare la variable K (incrément)

Me.ComboBox2.Clear 'vide la ComboBox2
Me.ListBox1.Clear 'vide la ListBox1
Erase TL 'vide le tableau TL
K = 1 'initialise la variable K
For I = 2 To UBound(TV, 1) 'boucle sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
    'si la donnée en colonne 1 de la boucle est égale a la valeur de la ComboBox1, alimente la ComboBox2 avec la donnée en colonne 2 de la boucle
    If TV(I, 1) = Me.ComboBox1.Value Then
        Me.ComboBox2.AddItem TV(I, 2)
        ReDim Preserve TL(1 To 3, 1 To K) 'redimensionne le tableau des lignes TL (3 lignes, K colonne)
        TL(1, K) = TV(I, 1) 'récupère dans la ligne 1 de TL la donnée en colonne 1 de TV
        TL(2, K) = TV(I, 2) 'récupère dans la ligne 2 de TL la donnée en colonne 2 de TV
        TL(3, K) = TV(I, 3) 'récupère dans la ligne 3 de TL la donnée en colonne 3 de TV
        K = K + 1 'incrémente K (ajoute une colonne au tableau des lignes TL)
    End If 'fin de la condition
Next I 'prochaine ligne de la boucle
If K > 1 Then Me.ListBox1.Column = TL 'si K est supérieure a un, alimente les colonnes de la ListBox1 avec le tableau TL
End Sub

Private Sub ComboBox2_Change() 'au changement de la Combobox1
Dim TL() As Variant 'déclare la variable TL (Tableau des Lignes)
Dim K As Integer 'déclare la variable K (incrément)

Me.ListBox1.Clear 'vide la ListBox1
Erase TL 'vide le tableau TL
K = 1 'initialise la variable K
For I = 2 To UBound(TV, 1) 'boucle sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
    'condition : si la donnée en colonne 1 de la boucle est égale a la valeur de la ComboBox1 et si la donnée en colonne 2 de la boucle est égale à la ComboBox2
    If TV(I, 1) = Me.ComboBox1.Value And TV(I, 2) = Me.ComboBox2.Value Then
        ReDim Preserve TL(1 To 3, 1 To K) 'redimensionne le tableau des lignes TL (3 lignes, K colonne)
        TL(1, K) = TV(I, 1) 'récupère dans la ligne 1 de TL la donnée en colonne 1 de TV
        TL(2, K) = TV(I, 2) 'récupère dans la ligne 2 de TL la donnée en colonne 2 de TV
        TL(3, K) = TV(I, 3) 'récupère dans la ligne 3 de TL la donnée en colonne 3 de TV
        K = K + 1 'incrémente K (ajoute une colonne au tableau des lignes TL)
    End If 'fin de la condition
Next I 'prochaine ligne de la boucle
If K > 1 Then Me.ListBox1.Column = TL 'si K est supérieure a un, alimente les colonnes de la ListBox1 avec le tableau TL
End Sub