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

VirginieG

XLDnaute Nouveau
Supporter XLD
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
 

Pièces jointes

  • Exemple-HE.xlsm
    24.9 KB · Affichages: 8
Dernière édition:
Solution
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 =...

job75

XLDnaute Barbatruc
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+
 

Pièces jointes

  • Exemple-HE(1).xlsm
    22.7 KB · Affichages: 9
Dernière édition:

VirginieG

XLDnaute Nouveau
Supporter XLD
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 ! :)
 
Dernière édition:

job75

XLDnaute Barbatruc
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.
 
Dernière édition:

VirginieG

XLDnaute Nouveau
Supporter XLD
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.
 
Dernière édition:

Statistiques des forums

Discussions
299 799
Messages
1 979 189
Membres
206 611
dernier inscrit
Ibrahima Ndoye