Filtrage complex

Function Epure$(List, Exclure, position&)
Dim t, n&
For Each t In List
  If t <> "" Then
    If IsError(Application.Match(Split(t)(0), Exclure, 0)) Then
      n = n + 1
      If n = position Then Epure = t: Exit Function
    End If
  End If
Next
End Function

=Epure(A$2:A$100;B$2:B$100;LIGNES(C$2:C2))

Function Epure$(List, Exclure, position&)
Dim t, n&
List = List.Value
Exclure = Exclure.Value
For Each t In List
  If t <> "" Then
    If IsError(Application.Match(Split(t)(0), Exclure, 0)) Then
      n = n + 1
      If n = position Then Epure = t: Exit Function
    End If
  End If
Next
End Function

Function Epure$(List, Exclure, position&)
Dim t, n&
List = List.Value
Exclure = Exclure.Value
For Each t In List
  If t <> "" Then
    If IsError(Application.Match(Left(t, 5), Exclure, 0)) Then
      n = n + 1
      If n = position Then Epure = t: Exit Function
    End If
  End If
Next
End Function

Function Epure(List, Exclure)
Dim t, n&, tablo$(9999) 'dimension maximum du tableau, à ajuster
List = List.Value
Exclure = Exclure.Value
For Each t In List
  If t <> "" Then
    If IsError(Application.Match(Left(t, 5), Exclure, 0)) Then
      tablo(n) = t
      n = n + 1
    End If
  End If
Next
Epure = Application.Transpose(tablo)
End Function

Option Explicit
Option Compare Text 'facultatif, la casse n'est pas prise en compte

Function Epure(List, Exclure)
Dim t1, t2, n&, tablo$(9999) 'dimension maximum du tableau, à ajuster
List = List.Value
Exclure = Exclure.Value
For Each t1 In List
  If t1 <> "" Then
    For Each t2 In Exclure
      If t2 <> "" And t1 Like t2 & "*" Then GoTo 1
    Next
    tablo(n) = t1
    n = n + 1
  End If
1 Next
Epure = Application.Transpose(tablo)
End Function

Private Sub CommandButton1_Click()
Epure Range("A2", [A65536].End(xlUp)), Range("B2", [B65536].End(xlUp))
End Sub

Option Explicit
Option Compare Text 'facultatif, la casse n'est pas prise en compte

Sub Epure(List, Exclure)
Dim t1, t2, n&, tablo$()
List = List.Value
Exclure = Exclure.Value
For Each t1 In List
  If t1 <> "" Then
    For Each t2 In Exclure
      If t2 <> "" And t1 Like t2 & "*" Then GoTo 1
    Next
    ReDim Preserve tablo(n)
    tablo(n) = t1
    n = n + 1
  End If
1 Next
'---restitution---
[C2:C65536].ClearContents
[C2].Resize(n) = Application.Transpose(tablo)
End Sub

Option Explicit
Option Compare Text 'facultatif, la casse n'est pas prise en compte

Sub Epure()
Dim List, Exclure, d As Object, t1, t2
List = Range("A2", [A65536].End(xlUp))
Exclure = Range("B2", [B65536].End(xlUp))
Set d = CreateObject("Scripting.Dictionary")
For Each t1 In List
  If t1 <> "" Then
    For Each t2 In Exclure
      If t2 <> "" And t1 Like t2 & "*" Then GoTo 1
    Next
    d(t1) = t1
  End If
1 Next
'---restitution---
[C2:C65536].ClearContents
[C2].Resize(d.Count) = Application.Transpose(d.Items)
End Sub

Sub Epure()
'déclare les varianles : List, Exclure, t1, t2 sont de type Variant
Dim List, Exclure, d As Object, t1, t2
'tableau des valeurs de A2 à la dernière cellule remplie colonne A
List = Range("A2", [A65536].End(xlUp))
'tableau des valeurs de B2 à la dernière cellule remplie colonne B
Exclure = Range("B2", [B65536].End(xlUp))
'crée l'objet d
Set d = CreateObject("Scripting.Dictionary")
'pour chaque item t1 dans le tableau List
For Each t1 In List
'si l'item t1 est <> "" alors...
If t1 <> "" Then
'pour chaque item t2 dans le tableau Exclure
For Each t2 In Exclure
'si t2 <> "" et si t1 commence par t2 ("*" est un caractère générique) alors aller à l'adresse 1
If t2 <> "" And t1 Like t2 & "*" Then GoTo 1
'item t2 suivant
Next
'crée un item de la collection d
d(t1) = t1
'ferme le bloc du 1er If
End If
' adresse 1 => item t1 suivant
1 Next
'---restitution---
'efface les valeurs de la plage C2:C65536
[C2:C65536].ClearContents
'entre les valeurs de d dans la plage commençant en C2 et de hauteur = nombre de valeurs de d
[C2].Resize(d.Count) = Application.Transpose(d.Items)
End Sub