filtrer avec plusieurs critères en VBA

blancolie

XLDnaute Impliqué
Bonsoir le forum;

Dans ce fichier ci-joint et dans l'onglet données planning un filtrage avec plusieurs critères.Dans la feuille données planning j'ai mis en H1 , J1 et L1 et c'est dans les cellules au fond gris qu'on met les critères.

Je m'explique : le code suivant :

VB:
Option Explicit
Option Compare Text    'la casse est ignor?e
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Sh As Worksheet, col&

    Set Sh = ThisWorkbook.Sheets("Données Planning")

    [A1].AutoFilter 'ca peux etre ca tout simplement


    Select Case Target.Address(0, 0)
    Case "I1": col = 3
    Case "K1": col = 4
    Case "M1": col = 5
    Case Else: col = 0:
    End Select

    If Target.Value <> "" And col <> 0 Then
        [A1].AutoFilter Field:=col, Criteria1:=Target.Value
    Else
        Sh.AutoFilterMode = False
    End If
End Sub



Ce code suivant qu'un membre m 'a gentiment construit en répondant à mon post précédent marche bien mais j'aimerais avoir un filtrage qui va plus dans le détail c'est a dire quand je sélectionne l'agent, j'aimerais qu'on puisse filtrer les différentes permanence et les différents périodes du même agent. j'espère avoir été assez clair. j'aimerais aussi faire l'inverse à partir de la période.

Si aucune cellule contenant de critères, faut que le filtrage s'efface. Peut-être que à partir d'un bouton, on peut réinitialiser mon petit menu ?

Cette liste est amené à s'agrandir ou à être diminué, don cil faut que le codage prenne en compte les rajouts de lignes ou de suppressions sinon, je risque d'avoir un erreur.

Merci à vous.

pouvez vous me mettre en parallèle le code au cas ou je n'arrive pas à ouvrir le fichier. cela m'arrive quelquefois a cause du vba. Merci à vous
 

Pièces jointes

  • Astreinte-exemple.xlsm
    119.8 KB · Affichages: 129
Dernière édition:

blancolie

XLDnaute Impliqué
Bonjour,

j'essaie d'adapter ce code dans mon vrai fichier. si je comprends bien le code :

If Target.Row = 1 Then ; c'est la ligne N°1 la ou je rentre mes critères ( nom de l'agent; la permanence, etc)

dans le code suivant :

j'ai remplacer uniquement les vlaurs par les cellules ou je vais rentrer mes critères et A8 c'est l'emplacement de mes entêtes. cela devrait marcher logiquement sauf si j'ai oublier quelques choses.

VB:
Option Explicit
Option Compare Text    'la casse est ignor?e
Private Sub Worksheet_Change(ByVal Target As Range)
    ActiveSheet.AutoFilterMode = False
    If Target.Column <= 6 Then Exit Sub
    [A8].AutoFilter    'ca peux etre ca tout simplement
    If Target.Row = 5 Then
        Select Case Target.Column
        Case 2, 4, 6
            If [B5] <> "" Then [A8].AutoFilter Field:=3, Criteria1:=[B5].Value
            If [D5] <> "" Then [A8].AutoFilter Field:=4, Criteria1:=[D5].Value
            If [F5] <> "" Then [A8].AutoFilter Field:=5, Criteria1:=[F5].Value
            If [B5] & [D5] & [F5] = "" Then [A8].AutoFilter
        Case Else
            ActiveSheet.AutoFilterMode = False
        End Select
    End If
End Sub
 

patricktoulon

XLDnaute Barbatruc
bonsoir
réfléchi 1 seconde

If Target.Column <= 6 Then Exit Sub
....
.....

Select Case Target.Column
Case 2, 4, 6
If [B5] <> "" Then [A8].AutoFilter Field:=3, Criteria1:=[B5].Value
If [D5] <> "" Then [A8].AutoFilter Field:=4, Criteria1:=[D5].Value
If [F5] <> "" Then [A8].AutoFilter Field:=5, Criteria1:=[F5].Value
If [B5] & [D5] & [F5] = "" Then [A8].AutoFilter

il n' y a pas quelque chose qui te gène?????????
 

blancolie

XLDnaute Impliqué
dans mon fichier, j'ai 6 colonnes comme ds l'exemple que je t ai mis. si je prends case 2 , 4 , 6 c'est les colonnes que je dois mettre mes critères de recherche. je ne vois pas trop. mes critères sont à rentrer sont a mettre en B5 , D5 , F5 et mon entête de mon tableau c 'est en A8 non je vois pas trop, je maitris pastrop le vba et case je vois pas a quoi cela correspond
 

blancolie

XLDnaute Impliqué
le nombre que j'ai mis 2 , 4 , 6 me fais sortir donc il faut que cela doit être supérieur à 6, c'est bien cela ? si c'est le cas , comment faire ? car mes critères se situent au dessus de mon tableau, donc ils sont forcément dans la fourchette 2, 4 , 6.

Si je dois mettre à coté et pas forcément sur la première ligne, il faudrait filtrer uniquement les lignes comprenant A8 et F8 pour que les données à côté de ce tableau restent apparant
 

blancolie

XLDnaute Impliqué
bon, j'ai réussi à faire quelque chose mais je pense que je suis à côté de la plaque quand même.

si case est 2 , 4, 6 des nombres pairs alors j' ai mis If Target.Column <= 1 car impair. mais cela ne doit pas être cela car si je change l'agent, cette fois ci, le filtrage disparait
 

patricktoulon

XLDnaute Barbatruc
dans ce cas la on change un peu
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
    ActiveSheet.AutoFilterMode = False
    If Intersect(Target, ActiveSheet.Range("B5,D5,F5")) Is Nothing Then Exit Sub
    [A8].AutoFilter    'ca peux etre ca tout simplement
    Select Case Target.Column
    Case 2, 4, 6
        If [B5] <> "" Then [A8].AutoFilter Field:=3, Criteria1:=[B5].Value
        If [D5] <> "" Then [A8].AutoFilter Field:=4, Criteria1:=[D5].Value
        If [F5] <> "" Then [A8].AutoFilter Field:=5, Criteria1:=[F5].Value
        If [B5] & [D5] & [F5] = "" Then [A8].AutoFilter
    Case Else
        ActiveSheet.AutoFilterMode = False
    End Select
End Sub
 

blancolie

XLDnaute Impliqué
bonsoir, j'ai adapté ce code qui marche très bien et j'ai rajouté une case date , cela fonctionne bien mais il y a un mais (lol). quand je tape 02/01/2020 dans la cellule; cela se transforme dans la boite de dialogue en 2/07/2020 et donc rian apparaît, normal. comment peut on y remedier ?

VB:
Option Explicit
Option Compare Text    'la casse est ignor?e


Private Sub Worksheet_Change(ByVal Target As Range)
    ActiveSheet.AutoFilterMode = False
    If Intersect(Target, ActiveSheet.Range("B5,D5,F5,B7")) Is Nothing Then Exit Sub
    [A10].AutoFilter    'ca peux etre ca tout simplement
    Select Case Target.Column
    Case 2, 4, 6
        If [B5] <> "" Then [A10].AutoFilter Field:=3, Criteria1:=[B5].Value
        If [D5] <> "" Then [A10].AutoFilter Field:=4, Criteria1:=[D5].Value
        If [F5] <> "" Then [A10].AutoFilter Field:=5, Criteria1:=[F5].Value
        If [B7] <> "" Then [A10].AutoFilter Field:=1, Criteria1:=[B7].Value
        If [B5] & [D5] & [F5] & [B7] = "" Then [A10].AutoFilter
    Case Else
        ActiveSheet.AutoFilterMode = False
    End Select
End Sub
 

blancolie

XLDnaute Impliqué
le problème c'est que quand je tape 07/02/2020, ds la petite fenêtre du filtrage cela me met 2/07/2020 pourquoi ? après je peux supprimer, c'est mon collègue qui me demande cela. Pour lui cela paufine encore plus ce qui a été fait. Après cela, le tour est fait. pensait pas quequ'une date pouvait poser problème
 

Discussions similaires

Statistiques des forums

Discussions
312 229
Messages
2 086 423
Membres
103 206
dernier inscrit
diambote