XL 2019 Filtre 3 critères minimum

[phddesi]

Bonjour
Pouvez-vous m’aider je souhaite un filtre avec 3 critères sur une colonne s’il vous plaît.
Merci d’avance

 

[sylvanu]

Bonjour Phddesi,
Pensez vous que vous puissiez obtenir une réponse pertinente avec une demande aussi vague ? 😂
Essayez de fournir un petit fichier test représentatif, ce sera beaucoup plus efficace.

 

[phddesi]

bonjour désolé petit oublie de ma part.
🙂

 

[sylvanu]

Re,
Un essai en PJ avec :

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

 

[phddesi]

merci pour votre retour mais est-ce possible d'intégrer directement les critères dans le macro.

 

[sylvanu]

Bien sur avec :

Tfiltre = Array("Apple 8", "Samsung Edge", "Apple X")

Mais l'outil devient alors figé.

 

[phddesi]

d'accord du coup je ne peux plus retirer le filtre pour avoir toute la liste c'est ça.

 

[sylvanu]

Vous ne pouvez pas avoir le beurre et l'argent du beurre. 😂
Soit les filtres sont dans le code et donc en "dur" et c'est immuable, soit les filtres sont programmables sur la feuille et vous pouvez tout avoir.
Ou vous créez un second bouton "Tout voir" pour remplir la fonction. Voir PJ.
A mon avis la première version est la plus "universelle", vous mettez les filtres que vous voulez, si vous voulez tout voir vous effacez les filtres.

 

[phddesi]

Oui c’est vrai.
Mais je veux filtrer sur la même feuille et pouvoir retirer le filtre après.
Pas filtrer sur une autre feuille

 

[sylvanu]

Alors utilisez simplement le filtrage XL sur la feuille entrepôt. Le vba ne sert à rien.

 

[phddesi]

Bonjour
Voila je vous ai fait un petit fichier avec les explications à l'intérieur de ce que je veux avec un filtre avec 3 critères.
sur le fichier TEST 1 a déjà une macro.

 

[sylvanu]

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 :

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

 

[phddesi]

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 :

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

Merci pour votre retour j'essaie tout ça t je reviens vers vous
Mais cela semble déjà correct.

 

[phddesi]

Re,
Un essai en PJ avec :

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

bonjour

je reviens vers vous est ce possible de masquer les lignes sans les supprimer.
bien cordialement

 

[phddesi]

bonjour

je reviens vers vous est ce possible de masquer les lignes sans les supprimer.
bien cordialement