Microsoft 365 VBA Excel : Filtres au-delà de 2 critères, quelle(s) solution(s) svp ?

VirginieG · 30 Mars 2022

Bonjour,

Il y a quelques temps, je suis venue vous demander de l'aide pour affiner mes scripts pour filtrer sur 2 critères.
Sujet ici :
Afficher filtres appliqués par macro dans la cellule B3 directement et non par F5 puis Réinitialiser

J'ai pu obtenir la solution grâce à @Marcel32, que je remercie encore.

Aujourd'hui, il me faudrait reprendre ce script pour l'évoluer sur + de 2 critères... Du coup, mon script actuel ne peut plus fonctionner apparemment...

N'étant pas experte, pourriez-vous m'aiguiller svp vers la meilleure solution svp ?

Toujours en VBA car l'utilisatrice finale ne saura pas utiliser les filtres automatiques, d'où ce besoin d'automatisation VBA par une boite de dialogue qui doit se succéder (ou en une seule pourquoi pas où elle ajoute par ex) où elle rentre une partie de ce qui est à exclure, autant de fois qu'il y en a puis doit obtenir le résultat.

Exemple de ce que j'aimerais obtenir :
(du moins, quelque chose dans ce style)

Elle clique sur le bouton "contre-indications"
rentrer la 1ère Contre-indication : elle écrit tout ou une partie (ulc pour ulcère par ex)
rentrer la 2ème contre-indication : elle écrit là encore une partie
ajouter une autre contre-indication : ...
==> rentrer la contre-indication :

ou bouton "afficher le résultat".

Les 2 scripts actuels :

VB:

Sub Sauf()

'Touche de raccourci du clavier: Ctrl+q

'variables

    Dim plage As Range
    Dim filtre As String

'filtre sur plage sur feuille 1, tableau de la A6 à G6
    Set plage = Sheets(1).Cells(4, 3).CurrentRegion

'saisie
    filtre1 = InputBox("Écrire la 1ère Contre-indication :" & Chr(13) & Chr(10) & "- Soit le terme entier," & Chr(13) & Chr(10) & "- Soit une partie (par ex : ulc pour ulcère)", "Contre-Indication 1")
    filtre2 = InputBox("Écrire la 2ème Contre-indication :" & Chr(13) & Chr(10) & "- Soit le terme entier," & Chr(13) & Chr(10) & "- Soit une partie", "Contre-Indication 2")
    If filtre1 <> "" Then filtre1 = "*" & filtre1 & "*"
    If filtre2 <> "" Then filtre2 = "*" & filtre2 & "*"

'réinitialisation des filtres
    plage.AutoFilter

'application de la macro
    plage.AutoFilter Field:=3, Criteria1:="<>" & filtre1, Operator:=xlAnd, Criteria2:="<>" & filtre2

'afficher en B1 le fitre 1 qu'on nomme F1 et le filtre 2 F2
    Range("B1") = "Contre-Indications : " & filtre1 & " - " & filtre2
      

End Sub

Sub Réinitialiser()

'Dans la feuille 1, on remet les filtres à zéro
With Sheets("Feuil1")
   If .AutoFilterMode And .FilterMode Then .ShowAllData

'on vide la cellule B1 où sont affichés les filtres appliqués
  Range("B1") = "Contre-Indications : " & ""

End With

End Sub

Voici le fichier d'exemple d'origine avec ces deux scripts qui était fait pour deux critères.

Merci encore de votre aide.

Bonne soirée.

Virginie

job75 · 3 Avril 2022

Bonjour VirginieG,

Voyez le fichier joint et ce code :

VB:

Sub Filtrer()
'Touche de raccourci du clavier: Ctrl+q
Dim filtre$, s, critere, x$, i&
filtre = InputBox("Entrez les contre-indications," & vbLf & "le terme entier ou une partie," & vbLf & "séparées par des tirets, exemple acc-ulc :", "Contre-Indications")
If filtre = "" Then Exit Sub
Application.ScreenUpdating = False
RAZ
[B1] = [B1] & filtre
s = Split(filtre, "-") 'critères
With [A3].CurrentRegion
    For i = 2 To .Rows.Count
        For Each critere In s 'critères
            x = LCase(Trim(critere))
            If InStr(LCase(.Cells(i, 3)), x) Then .Rows(i).Hidden = True: Exit For
    Next critere, i
End With
Application.ScreenUpdating = True
End Sub

Sub RAZ()
Rows.Hidden =...

VirginieG · 3 Avril 2022

Coucou

Un petit up

Bon dimanche et merci

job75 · 3 Avril 2022

Bonjour VirginieG,

Voyez le fichier joint et ce code :

VB:

Sub Filtrer()
'Touche de raccourci du clavier: Ctrl+q
Dim filtre$, s, critere, x$, i&
filtre = InputBox("Entrez les contre-indications," & vbLf & "le terme entier ou une partie," & vbLf & "séparées par des tirets, exemple acc-ulc :", "Contre-Indications")
If filtre = "" Then Exit Sub
Application.ScreenUpdating = False
RAZ
[B1] = [B1] & filtre
s = Split(filtre, "-") 'critères
With [A3].CurrentRegion
    For i = 2 To .Rows.Count
        For Each critere In s 'critères
            x = LCase(Trim(critere))
            If InStr(LCase(.Cells(i, 3)), x) Then .Rows(i).Hidden = True: Exit For
    Next critere, i
End With
Application.ScreenUpdating = True
End Sub

Sub RAZ()
Rows.Hidden = False
[B1] = "Contre-Indications : "
End Sub

A+

VirginieG · 3 Avril 2022

Un grand merci !
Je vais essayer de suite.

VirginieG · 3 Avril 2022

C'est génial ! Merci beaucoup.

Pour ceux qui passeraient par là, le script demande d'écrire une partie de ce qu'on cherche suivi du signe tiret (-) du 6 puis le 2ème critère etc.

Est-ce que c'est compliqué de rajouter un bouton "critère suivant" avec la même boite de dialogue de formulaire plutôt que taper le signe tiret ?

Merci encore !

job75 · 3 Avril 2022

Au post #3 j'avais interverti les 2 boucles, prenez le fichier corrigé.

Edit : votre dernière question montre que vous n'avez pas encore compris que les MsgBox en cascade c'est exaspérant, il ne faut pas en abuser.

VirginieG · 3 Avril 2022

J'avais pris le fichier et ça marchait nickel.

Mais, est-ce possible de faire plutôt un bouton [critère suivant] où l'utilisateur écrit le critère suivant et ainsi de suite ?

job75 · 3 Avril 2022

Non ça ne marchait pas nickel, c'est pourquoi j'ai corrigé le post #3.

Lisez mon post #6 et son Edit.

VirginieG · 3 Avril 2022

job75 à dit:
Non ça ne marchait pas nickel, c'est pourquoi j'ai corrigé le post #3.

Lisez mon post #6 et son Edit.

Merci, j'ai bien récupéré le fichier corrigé.
Je n'ai pas vu la différence à l'utilisation mais je vais garder cette dernière version.

Pourquoi "exaspérant" de faire des MsgBox en cascade ?
Car si l'utilisteur tape "ulc", puis appuie sur bouton ajouter un critère, en dessous se trouve un nouveau champ où il tape "hép", bouton suivant jusqu'à ce qu'il est tout entré puis bouton OK.
Où se trouverait le problème svp ?
Je veux juste comprendre.

Car, je pensais que ce serait plus simple pour l'utilisateur que de BIEN LIRE ce qu'il faut faire dans la boite de dialogue et bien faire le signe TIRET entre chaque critère.

Est-ce que faire une cascade serait lourd pour l'exécution du script ? Ou autre ?

merci de m'éclairer.

job75 · 3 Avril 2022

Oui ce serait lourd car il faudrait un UserForm.

C'est une erreur de faire des usines à gaz, ne comptez pas sur moi.

job75 · 3 Avril 2022

Il est quand même évident que faire un UserForm juste pour entrer un tiret c'est débile.

VirginieG · 3 Avril 2022

Pas de souci, je voulais juste comprendre où était le souci.

Côté esthétique c'était plus propre à mon sens.
Mais je comprends que ce soit long à faire et peut-être plus lourd.

Aucun souci, un grand merci de ce que vous avez fait en tout cas.

bonne soirée.

Microsoft 365 VBA Excel : Filtres au-delà de 2 critères, quelle(s) solution(s) svp ?

VirginieG

XLDnaute Nouveau

Pièces jointes

job75

VirginieG

XLDnaute Nouveau

job75

XLDnaute Barbatruc

Pièces jointes

VirginieG

XLDnaute Nouveau

VirginieG

XLDnaute Nouveau

job75

XLDnaute Barbatruc

VirginieG

XLDnaute Nouveau

job75

XLDnaute Barbatruc

VirginieG

XLDnaute Nouveau

job75

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

VirginieG

XLDnaute Nouveau

Discussions similaires