XL 2016 Affiche resultat d'une recherche dans listbox

Private Sub TextBox1_Change()
UserForm_Initialize
End Sub

Private Sub UserForm_Initialize()
Dim critere$, P As Range, ncol%, tablo, i&, test As Boolean, j%, n&, resu()
critere = "*" & LCase(TextBox1) & "*" 'minuscules pour ignorer la casse
Set P = [A1].CurrentRegion
Set P = P.Resize(P.Rows.Count + 1) 'au moins 2 lignes
ncol = P.Columns.Count
ListBox2.ColumnCount = ncol
tablo = P 'matrice, plus rapide
For i = 2 To UBound(tablo) - 1
    test = False
    For j = 1 To ncol
        Select Case j
            Case 2: If Format(tablo(i, j), "mmm-yy") Like critere Then test = True: Exit For
            Case 11: If Format(tablo(i, j), "dd-mmm-yy") Like critere Then test = True: Exit For
            Case Else: If LCase(tablo(i, j)) Like critere Then test = True: Exit For
        End Select
    Next j
    If test Then
        n = n + 1
        ReDim Preserve resu(1 To ncol, 1 To n) 'tableau transposé
        For j = 1 To ncol
            resu(j, n) = Switch(j = 2, Format(tablo(i, j), "mmm-yy"), j = 11, Format(tablo(i, j), "dd-mmm-yy"), True, tablo(i, j))
        Next j
    End If
Next i
If n = 0 Then ListBox2.Clear: Exit Sub
'---transposition et remplissage de la ListBox---
ReDim tablo(1 To n, 1 To ncol)
For i = 1 To n
    For j = 1 To ncol
        tablo(i, j) = resu(j, i)
Next j, i
ListBox2.List = tablo
End Sub

Option Compare Text
Dim f, TblBD, ColVisu(), NbCol
Private Sub UserForm_Initialize()
  Set f = Sheets("BD")
  Set Rng = f.Range("A2:Z" & f.[A65000].End(xlUp).Row)
  TblBD = Rng.Value ' rapidité
  ColVisu = Array(1, 2, 3, 5, 6, 7, 8, 10, 11) ' Colonnes à visualiser (adapter)
  NbCol = UBound(ColVisu) + 1
  ReDim TblTitreListBox(1 To UBound(ColVisu) + 1)
  TitreBD = Application.Transpose(Rng.Offset(-1).Resize(1).Value)
  For i = LBound(ColVisu) To UBound(ColVisu)
    TblTitreListBox(i + 1) = TitreBD(ColVisu(i), 1)
  Next i
  Me.ComboTri.List = TblTitreListBox
  '---- Contenu ListBox initial
  EnteteListBox
  Affiche
End Sub

Private Sub TextBox1_Change()
  Affiche
End Sub

Sub Affiche()
  temp = "*" & Me.TextBox1 & "*"
  Dim Tbl(): n = 0
  For i = 1 To UBound(TblBD)
    If TblBD(i, 11) Like temp Then
      n = n + 1: ReDim Preserve Tbl(1 To NbCol, 1 To n)
      c = 0
      For Each k In ColVisu
        c = c + 1: Tbl(c, n) = TblBD(i, k)
      Next k
    End If
  Next i
  If n > 0 Then Me.ListBox1.Column = Tbl Else Me.ListBox1.Clear
End Sub

Sub EnteteListBox()
  x = Me.ListBox1.Left + 8
  y = Me.ListBox1.Top - 12
  For Each k In ColVisu
    Set Lab = Me.Controls.Add("Forms.Label.1")
    Lab.Caption = f.Cells(1, k)
    Lab.Top = y
    Lab.Left = x
    x = x + f.Columns(k).Width * 1#
    temp = temp & f.Columns(k).Width * 1# & ";"
  Next
  temp = Left(temp, Len(temp) - 1)
  Me.ListBox1.ColumnCount = UBound(ColVisu) + 1
  Me.ListBox1.ColumnWidths = temp
End Sub

Private Sub ComboTri_click()
  Dim Tbl()
  colTri = Me.ComboTri.ListIndex
  Tbl = Me.ListBox1.List
  TriMultiCol Tbl, LBound(Tbl), UBound(Tbl), colTri
  Me.ListBox1.List = Tbl
End Sub

Sub TriMultiCol(a, gauc, droi, colTri) ' Quick sort
  ref = a((gauc + droi) \ 2, colTri)
  g = gauc: d = droi
  Do
    Do While a(g, colTri) < ref: g = g + 1: Loop
    Do While ref < a(d, colTri): d = d - 1: Loop
    If g <= d Then
       For c = LBound(a, 2) To UBound(a, 2)
          temp = a(g, c): a(g, c) = a(d, c): a(d, c) = temp
       Next
       g = g + 1: d = d - 1
     End If
   Loop While g <= d
   If g < droi Then TriMultiCol a, g, droi, colTri
   If gauc < d Then TriMultiCol a, gauc, d, colTri
End Sub

Private Sub TextBox1_Change()
UserForm_Initialize
End Sub

Private Sub UserForm_Initialize()
Dim P As Range
ThisWorkbook.Names.Add "Critere", "*" & LCase(TextBox1) & "*" 'nom défini, minuscules pour ignorer la casse
Set P = [A1].CurrentRegion
ListBox2.ColumnCount = P.Columns.Count
P(2, P.Columns.Count + 2) = "=Test(Critere," & P.Rows(2).Address(0, 0) & ")" 'voir la fonction Test dans Module1
With Feuil2 'CodeName
    .Cells.Clear 'RAZ
    P.AdvancedFilter xlFilterCopy, P(1, P.Columns.Count + 2).Resize(2), .Range(P.Rows(1).Address) 'filtre avancé
    P(2, P.Columns.Count + 2) = ""
    If .UsedRange.Rows.Count = 1 Then
        ListBox2.RowSource = ""
    Else
        .Rows(1).Delete
        ListBox2.RowSource = .UsedRange.Address(External:=True)
    End If
End With
End Sub

Function Test(critere$, plage As Range)
Dim j%
For j = 1 To plage.Count
    Select Case j
        Case 2: If Format(plage(j), "mmm-yy") Like critere Then Test = True: Exit Function
        Case 11: If Format(plage(j), "dd-mmm-yy") Like critere Then Test = True: Exit Function
        Case Else: If LCase(plage(j)) Like critere Then Test = True: Exit Function
    End Select
Next
End Function