XL 2019 filtre avancé VBA

 :
Option Compare Text
Dim TblBD(), dchoisis1, dchoisis2, dchoisis3, nomtableau, NbCol

Private Sub ListBox1_Click()

End Sub

Private Sub UserForm_Initialize()
 
  nomtableau = "tableau1"
  NbCol = Range(nomtableau).Columns.Count
  TblBD = Range(nomtableau).Value
  Set d = CreateObject("scripting.dictionary")
  For i = 1 To Range(nomtableau).Rows.Count
    [COLOR=rgb(250, 197, 28)]tmp = TblBD(i, 13): d(tmp) = ""  [/COLOR][COLOR=rgb(97, 189, 109)]' je pense que mon souci démarre ici
  Next i[/COLOR]
  Me.OptionsGenre.MultiSelect = fmMultiSelectMulti
  Me.OptionsGenre.ListStyle = 1 'frmliststyleoption
  Tbl = d.keys
  Tri Tbl, LBound(Tbl), UBound(Tbl)
  Me.OptionsGenre.List = Tbl
  '--
  Set d = CreateObject("scripting.dictionary")
  For i = 1 To Range(nomtableau).Rows.Count
    tmp = TblBD(i, 18): d(tmp) = ""
  Next i
  Me.OptionsArtiste.MultiSelect = fmMultiSelectMulti
  Me.OptionsArtiste.ListStyle = 1 'frmliststyleoption
  Tbl = d.keys
  Tri Tbl, LBound(Tbl), UBound(Tbl)
  Me.OptionsArtiste.List = Tbl
  '---
   Set d = CreateObject("scripting.dictionary")
  For i = 1 To Range(nomtableau).Rows.Count
    tmp = TblBD(i, 19): d(tmp) = ""
  Next i
  Me.OptionAlbum.MultiSelect = fmMultiSelectMulti
  Me.OptionAlbum.ListStyle = 1 'frmliststyleoption
  Tbl = d.keys
  Tri Tbl, LBound(Tbl), UBound(Tbl)
  Me.OptionAlbum.List = Tbl
  '--
  Me.ListBox1.ColumnCount = Range(nomtableau).Columns.Count + 1
  Me.ListBox1.List = TblBD
  EnteteListBox
End Sub
Private Sub OptionsGenre_change()
  Affiche
End Sub
Private Sub OptionsArtiste_change()
  Affiche
End Sub
Private Sub OptionAlbum_change()
  Affiche
End Sub
Sub Affiche()
  Set dchoisis1 = CreateObject("Scripting.Dictionary")
  For i = 0 To Me.OptionsGenre.ListCount - 1
    If Me.OptionsGenre.Selected(i) Then dchoisis1(Me.OptionsGenre.List(i, 0)) = ""
  Next i
  Set dchoisis2 = CreateObject("Scripting.Dictionary")
  For i = 0 To Me.OptionsArtiste.ListCount - 1
    If Me.OptionsArtiste.Selected(i) Then dchoisis2(Me.OptionsArtiste.List(i, 0)) = ""
  Next i
     Set dchoisis3 = CreateObject("Scripting.Dictionary")
  For i = 0 To Me.OptionAlbum.ListCount - 1
    If Me.OptionAlbum.Selected(i) Then dchoisis3(Me.OptionAlbum.List(i, 0)) = ""
  Next i
  Dim Tbl2(): n = 0: Ncol = UBound(TblBD, 2)
  For i = 1 To UBound(TblBD)
    tmp = TblBD(i, 13): tmp2 = TblBD(i, 2): tmp3 = TblBD(i, 3)
    If (dchoisis1.exists(tmp) Or dchoisis1.Count = 0) And (dchoisis2.exists(tmp2) Or dchoisis2.Count = 0) And (dchoisis3.exists(tmp3) Or dchoisis3.Count = 0) Then
        n = n + 1: ReDim Preserve Tbl2(1 To Ncol, 1 To n)
        For k = 1 To Ncol: Tbl2(k, n) = TblBD(i, k): Next k
    End If
  Next i
  If n > 0 Then Me.ListBox1.Column = Tbl2 Else Me.ListBox1.Clear
  Me.LabelLigne.Caption = n & " élèves"
End Sub
Sub Tri(a, gauc, droi) ' Quick sort
 ref = CStr(a((gauc + droi) \ 2))
 g = gauc: d = droi
 Do
  Do While CStr(a(g)) < ref: g = g + 1: Loop
  Do While ref < CStr(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

Sub EnteteListBox()
   x = Me.ListBox1.Left + 8
   Y = Me.ListBox1.Top - 15
   For c = 1 To NbCol
       Set Lab = Me.Controls.Add("Forms.Label.1")
       Lab.Caption = Range(nomtableau).Offset(-1).Item(1, c)
       Lab.ForeColor = vbBlack
       Lab.Top = Y
       Lab.Left = x
       Lab.Height = 15
       Lab.Width = Range(nomtableau).Columns(c).Width * 1#
       x = x + Range(nomtableau).Columns(c).Width * 1
       tempcol = tempcol & Range(nomtableau).Columns(c).Width * 1# & ";"
   Next c
   tempcol = tempcol
   On Error Resume Next
   Me.ListBox1.ColumnWidths = tempcol
   On Error GoTo 0
End Sub

[fin de code]
Merci d'avance