Discussion :

[perlodz]

Salut tous le monde;

je veux filtrer une liste automatiquement avec plusieurs critères, vous pouvez trouver dans le fichier attaché les tableaux source et le resultat souhaité avec les critères a prendre en considération.

Merci d'avance.

[révèr]

Bonjour perlodz,

Je te conseillerai de boucler sur toute la portée de ton tableau :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
 
Dim Wb As ThisWorkbook
Dim WbO As Worksheet
Dim t As ListObject
 
Set WbO = Wb.Sheets(1)
Set t = WbO.ListObjects("t_data")
 
For Each Cell In t.ListColumns(1).DataBodyRange
    If ... and .... and .... Then
    'Insérer critères inverses à ce que tu cherches
         Cell.EntireRow.Hidden = True
    End If
Next Cell

[perlodz]

Merci pour votre réponse, j'ai une petite experience dans les Macros, SVP, si possible de modifier le fichier attaché avec votre code.

Salutations.

[révèr]

Il ne m'est malheureusement pas possible d'accéder aux macros d'un classeur téléchargé, sécurité IT au travail ^^

Mais pour sélectionner toutes les données de ton tableau, tu vas dans sur n'importe quelle cellule de ce dernier et tu fais "Ctrl + * " Puis, mettre sous forme de tableau et tu le renommes en "t_data"

Set WbO = Wb.Sheets(1) : Cette ligne va pointer sur la feuille 1, à toi de définir à quelle position est ta feuille ou bien d'utiliser le nom de ta feuille comme suit - Wb.Sheets("NomFeuille").

Set t = WbO.ListObjects("t_data") : Cette ligne va pointer sur l'objet "t_data" qui est un tableau structuré. il se situe dans la feuille préalablement définie

For Each Cell In t.ListColumns(1).DataBodyRange : Cette ligne va parcourir chaque cellule contenue dans la colonne 1 du corps de ton tableau (hors en-tête et lignes de total)

A l'intérieur de cette boucle, c'est à toi de définir les besoins que tu as. Je te conseille dans ton cas de partir sur les conditions opposées à ce que tu cherches pour chacun de tes critères

Cell.EntireRow.Hidden = True : Cette ligne va masquer chaque ligne qui répond aux critères définis dans ton IF.

Next Cell : Tout simplement boucler sur la Cellule suivante

[perlodz]

Merci beaucoup pour votre explication détaillée, je vais essayer de suivre votre explication et l'appliquer a mon tableau, mais j'attends toujours quelqu'un pour me modifier le fichier attaché selon mes besoins

Merci à tous

[révèr]

Les personnes du forum ne sont pas là pour travailler à ta place, nous sommes là pour t'aider et t'orienter. C'est toi qui écrira ton code et pas nous, mais nous t'aiderons à faire en sorte qu'il fonctionne, voir t'aiderons à l'optimiser le cas échéant.

Tu n'apprendras rien si on te donne du tout cuit

[78chris]

Bonjour

Tu peux faire cela sans VBA avec PowerQuery, en add on à partir de 2010, intégré à partir de 2016

[ARTURO83]

Bonjour,

Autre solution, une formule pour chaque cas de figure suivi d' une mise en forme. Un bout de VBA pour faire tout ça. Ne reste plus qu'à cliquer sur le bouton.

le code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Sub Filtrage()
    Dim DerLig As Long, Lig As Long, i As Long
    Application.ScreenUpdating = False
    DerLig = Range("A" & Rows.Count).End(xlUp).Row
 
    'Les formules
    Range("G2:G" & DerLig).FormulaR1C1 = "=IF(COUNTIF(R2C2:R9C2,RC2)=1,1,2)"
    Range("H2:H" & DerLig).FormulaR1C1 = "=COUNTIFS(RC7,1,RC4,""Consultation"")"
    Range("I2:I" & DerLig).FormulaR1C1 = "=COUNTIFS(RC7,2,RC4,""Controle"",RC6,""En instance"")"
    Range("J2:J" & DerLig).FormulaR1C1 = "=COUNTIFS(RC7,1,RC4,""Controle"",RC6,""En instance"")"
    Range("K2:K" & DerLig).FormulaR1C1 = "=SUM(RC[-3]:RC[-1])"
 
    'Récupération des données correspondant aux critères
    Lig = 2
    For i = 2 To DerLig
        If Cells(i, "K") <> 0 Then
            Range(Cells(i, "A"), Cells(i, "F")).Copy Cells(Lig, "M")
            Lig = Lig + 1
        End If
    Next i
    'Suppression des calculs intermédiaires
    Columns("G:L").Clear
End Sub

Le fichier
Pièce jointe 541082

Cdlt

[perlodz]

je vous remercercie infiniment pour votre aide, je t'ai informé precedemment que j'ai une petite experience dans les marcros, cet experience ne me permet pas d'appliquer votre code sur mon fichier.

c'est pour ça j'ai demandé d'un quelqu'un de m'aider pour modifier mon fichier suite a votre proposition

Salutations.

merci pour votre proposition, le fichier Excel concerné est partagé sous réseau avec plusieurs utilisateurs qui ont plusieurs versions d'Execl différentes.

Merci beaucoup pour votre reponse, votre code ça marche trés bien (mais, lors de la modification dans le tableau source; il supprime pas un resultat déja existe dans le tableau résultat qui ne correspond pas aux critères de filtrage aprés cette modification, donc, il faux supprimer le tableau résultat a chaque fois avant d'executer le macro) , j'essai de le modifier et de l'appliquer sur mon fichier source.

[ARTURO83]

il faux supprimer le tableau résultat a chaque fois avant d'executer le macro

Voilà qui prend en compte l'effacement des précédents résultats

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
Sub Filtrage()
    Dim DerLig As Long, Lig As Long, i As Long
    Application.ScreenUpdating = False
 
    'Nettoyage des précédents résultats
    Range("M2:R10000").Clear
 
    'Les formules
    DerLig = Range("A" & Rows.Count).End(xlUp).Row
    Range("G2:G" & DerLig).FormulaR1C1 = "=IF(COUNTIF(R2C2:R9C2,RC2)=1,1,2)"
    Range("H2:H" & DerLig).FormulaR1C1 = "=COUNTIFS(RC7,1,RC4,""Consultation"")"
    Range("I2:I" & DerLig).FormulaR1C1 = "=COUNTIFS(RC7,2,RC4,""Controle"",RC6,""En instance"")"
    Range("J2:J" & DerLig).FormulaR1C1 = "=COUNTIFS(RC7,1,RC4,""Controle"",RC6,""En instance"")"
    Range("K2:K" & DerLig).FormulaR1C1 = "=SUM(RC[-3]:RC[-1])"
 
    'Récupération des données correspondant aux critères
    Lig = 2
    For i = 2 To DerLig
        If Cells(i, "K") <> 0 Then
            Range(Cells(i, "A"), Cells(i, "F")).Copy Cells(Lig, "M")
            Lig = Lig + 1
        End If
    Next i
    'Suppression des calculs intermédiaires
    Columns("G:L").Clear
End Sub

Cdlt

[perlodz]

merci infiniment, maintenant le code fonctionne 10/10

[boisgontierjacques]

Bonjour,


Sans VBA, avec le filtre avancé et un critère formule.

En H2

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

=OU(ET(NB.SI(B:B;B2)=1;D2="Consultation");ET(NB.SI(B:B;B2)>1;D2="Controle";F2="En instance");ET(D2="Controle";F2="En instance"))

Spécifier H1:H2 comme critère.


Boisgontier

[perlodz]

merci beaucoup pour votre aide, c'est exacte que je cherche, c'est trés simple et efficace, je vous demande une autre fois de m'aider pour exécuter ce filtre automatiquement sans afficher les ligne filtrées sur le tableau source, et de copier les résultats vers une autre feuille.

je vous remercie beaucoup.

Salutations.

[boisgontierjacques]

Bonjour,

Vous pouvez modifier la formule.
Pour faire une extraction sans macro, il faut se placer dans la feuille d'extraction.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

=OU(ET(NB.SI(BD!B:B;BD!B2)=1;BD!D2="Consultation");ET(NB.SI(BD!B:B;BD!B2)>1;BD!D2="Controle";BD!F2="En instance");ET(BD!D2="Controle";BD!F2="En instance"))

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
Sub extrait()
    Sheets("BD").Range("A1:F10000").AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=Range("K1:K2"), CopyToRange:=Range("A1:F1"), Unique:=False
End Sub

Boisgontier

[perlodz]

C'est genial, ça marche trés bien,

Merci infiniment.