Function FiltrerTab(FullTab() As Variant, Critère As String, ColCrit As Integer) As Boolean 'filtre le FullTab selon UN critère sur UNE colonne et renvoie vrai ou faux si le tableau a été filtré
Dim b() As Variant
Critère = "*" & UCase(Critère) & "*"
n = 0
NbCol = UBound(FullTab, 2)
For i = LBound(FullTab, 1) To UBound(FullTab, 1)
If UCase(FullTab(i, ColCrit)) Like Critère Then 'si la ligne répond au critère
n = n + 1: ReDim Preserve b(1 To NbCol, 1 To n) 'on dimensionne le tablo résultat b
For K = 1 To NbCol: b(K, n) = FullTab(i, K): Next K 'on remplit la nouvelle ligne
End If
Next i
If n > 0 Then
FullTab = Application.WorksheetFunction.Transpose(b)
FiltrerTab = True
Else 'aucune ligne ne répond au critère
FiltrerTab = False 'le tableau FullTab n'a pas été modifié==> il contient toujours TOUTES les données non filtrées
End If
End Function
Function FiltrerTabMultiCrit(FullTab() As Variant, Critère As Variant, ColCrit As Variant) As Boolean 'filtre le FullTab selon PLUSIEURS critères sur PLUSIEURS colonnes et renvoie vrai ou faux si le tableau a été filtré
'Peut remplacer la fonction FiltrerTab (à condition de déclarer les paramètres d'appel en array)
Dim b() As Variant
Dim i As Long
Dim LigToKeep As Boolean
Dim n As Long
n = 0
NbCol = UBound(FullTab, 2)
For i = LBound(FullTab, 1) To UBound(FullTab, 1)
LigToKeep = True
For IndCrit = LBound(Critère) To UBound(Critère)
Crit = "*" & UCase(Critère(IndCrit)) & "*"
If Not (UCase(FullTab(i, ColCrit(IndCrit)))) Like Crit Then 'si la ligne répond au critère
LigToKeep = False
Exit For
End If
Next IndCrit
If LigToKeep Then
n = n + 1: ReDim Preserve b(1 To NbCol, 1 To n) 'on dimensionne le tablo résultat b
For K = 1 To NbCol: b(K, n) = FullTab(i, K): Next K 'on remplit la nouvelle ligne
End If
Next i
If n > 0 Then
FullTab = Application.WorksheetFunction.Transpose(b)
FiltrerTabMultiCrit = True
Else 'aucune ligne ne répond au critère
FiltrerTabMultiCrit = False 'le tableau FullTab n'a pas été modifié==> il contient toujours TOUTES les données non filtrées
End If
End Function
