XL 2019 Filtre 3 critères minimum

sylvanu à dit:

Bonsoir Phddesi,
C'est plus clair maintenant.🙂

Vous avez surement remarqué que dans les filtres, en VBA, on ne peut mettre que 2 critères.
Donc en PJ une tricherie :
On remplace les noms désiré par £Nom, on filtre sur 1 critère "£*" puis on supprime les £.
😂 Pas très orthodoxe mais efficace :

VB:

Sub Filtre_Hors_Samsung_BB()
    Ajout£
    Sheets("entrepot").Select
    Range("Base[#All]").Select
    ActiveSheet.ListObjects("Base").Range.AutoFilter Field:=3, _
    Criteria1:="<>*£*"
    Suppression£
    [A1].Select
End Sub
Sub Ajout£()
N = [Base].Rows.Count
For i = 1 To [Base].Rows.Count
    Tele = Left([Base[modele tele]].Item(i), 6)
    If Tele = "Samsun" Or Tele = "huawei" Or Tele = "BB" Then [Base[modele tele]].Item(i) = "£" & [Base[modele tele]].Item(i)
Next i
End Sub
Sub Suppression£()
N = [Base].Rows.Count
For i = 1 To [Base].Rows.Count
    If Left([Base[modele tele]].Item(i), 1) = "£" Then [Base[modele tele]].Item(i) = Mid([Base[modele tele]].Item(i), 2)
Next i
End Sub

Cliquez pour agrandir...

sylvanu à dit:

Re,
Un essai en PJ avec :

VB:

Sub Cherche()
    Range("A2:C" & Application.Max(2, [B65000].End(xlUp).Row)).ClearContents
    Application.ScreenUpdating = False
    Dim Tfiltre, BDD, Ligne%, i%, j%, k%
    Tfiltre = Range("G2:G" & [G65000].End(xlUp).Row)
    BDD = Sheets("Entrepot").Range("A2:C" & Sheets("Entrepot").[A65000].End(xlUp).Row)
    Ligne = 2
    For i = 1 To UBound(BDD)
        For j = 1 To UBound(Tfiltre)
            If BDD(i, 3) Like "*" & Tfiltre(j, 1) & "*" Then
                For k = 1 To 3
                    Cells(Ligne, k) = BDD(i, k)
                Next k
                Ligne = Ligne + 1
            End If
        Next j
    Next i
    Application.ScreenUpdating = True
End Sub

Cliquez pour agrandir...