Discussion :

[Bell2018]

Bonjour,

J'ai un problème avec le filtre à choix multiple. Dans un Userform j'ai 6 CheckBox nommées (CheckBa,CheckBb,CheckBc,CheckBd,Checke,CheckBf)et j aimerai que lorsque je coche 2 checkBox voir plus, que le filte de ma base de données puise être appliqué.

je parviens pour l'instant à faire le filtre à l'aide d'une seule checkbox coché.
voici mon 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
Private Sub sendFormValuesToExcel()
    If (OptionS1) Then
        Range("J2").FormulaR1C1 = OptionS1.Caption
        If (CheckBa) Then
            Range("K2").FormulaR1C1 = "a"
        End If
    ElseIf (OptionS2) Then
         Range("J2").FormulaR1C1 = OptionS2.Caption
         'Range("K2").FormulaR1C1 = "a"
         'Range("P2").FormulaR1C1 = "b"
         'Range("P2").FormulaR1C1 = CheckBb.Caption
    End If
 
End Sub

Code :

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

1
2
3
4
Private Sub search()
    sendFormValuesToExcel
    Macrotrigroupe
End Sub

Code :

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

1
2
3
Private Sub OptionS1_Change()
    search
End Sub

Code :

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

1
2
3
Private Sub Cmdfiltre_Click()
    search
End Sub

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
Sub Macrotrigroupe()
'
' Macrotrigroupe Macro
'
 
'
    Application.CutCopyMode = False
    Application.CutCopyMode = False
    Application.CutCopyMode = False
    Range("Tableau14[#All]").AdvancedFilter Action:=xlFilterCopy, CriteriaRange _
        :=Range("I1:P2"), CopyToRange:=Range("I6:O6"), Unique:=False
End Sub

merci d'avance pour l'aide.

[MarcelG]

Bonjour Bell et bienvenu sur le Forum,

Remarques
- Pour le rendre plus accessible, tu peux baliser ton code par les bornes "#"
- Pour affecter une valeur à une cellule, mieux vaut utiliser la propriété Value que Formula

Pour ta problématique.
Tout d'abord consulter le tutoriel de Philipe à ce sujet
Dans ce cadre, tu peux nommer chaque cellule de ta zone de critères.
Celles-ci seraient alimentées par le formulaire
Le tutoriel comprend une partie VBA dont tu pourras t'inspirer

[Bell2018]

Bonjour MarcelG et merci pour les remarques,

J'aimerai préciser que j'ai déjà eu à parcourir le tuto indiqué, mais je reste sur ma faim. je précise bien que j'ai bien fait mon filtre avancé sur excel qui ma généré une macro par la suite.

je réussi aussi à faire le filtre à aide d'une seule checkbox coché, mais je veux que cela soit aussi possible lorsque le coche plusieurs checkbox.

ma base de données est constitué comme suit:
colonne A: matricule
colonne B: nom
colonne C: prénom
colonne D:groupe ( il existe 6 groupe de a-f) je représente ceci dans nom userform par des checkbox.
j'aimerai que en cochant les groupe a, d et f par exemple comme critère du tri, ma plage de résulta n'affiche que les individus appartenant à ce groupe.

j'espère que j'ai mieux exposé mon problème merci

[MarcelG]

Bonjour Bell, Bonjour au Forum,

Je reprends l'un des codes du tutoriel à un numéro de ligne près

Code :

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

1
2
3
4
5
6
Sub Filter()
  Range("A1:G16").AdvancedFilter _
         Action:=xlFilterInPlace, _
         CriteriaRange:=Range("I1:L4"), _
         Unique:=False
End Sub

(Pour l'instant, passons sur le rattachement des objets Range)

Ici la plage de critères est I1:L4.
Prenons l'une des cellules comprises dans ce Range. Exemple L3
Si la cellule L3 est nommée "lacheck_a" alors le code peut exécuter l'information de cette cellule.

Code :

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

If Chx_lacheck_a = True Then Range("lacheck_a").Value = "a"

Idem pour les autres cellule à informer au sein de la zone de critères.

Le filtre s'effectuera donc en fonction des valeurs de contrôles du formulaire.

Essaie d'adapter ton code en conséquence et reviens avec celui-ci dans son intégralité.

[Bell2018]

Bonjour MarrcelG et à tous,

En adaptant le code envoyé au mien, cela ne fonctionne pas bref il y plus de tri en fonction de mes critères de choix c'est toute ma base de données qui est repris dans la zone du filtre choisi.

macro du filtre avancé

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
Sub tri_2()
'
' tri_2 Macro
'
 
'
    Application.CutCopyMode = False
    Application.CutCopyMode = False
    Application.CutCopyMode = False
    Range("Tableau14[#All]").AdvancedFilter Action:=xlFilterCopy, CriteriaRange _
        :=Range("I1:P5"), CopyToRange:=Range("I6:O6"), Unique:=False
End Sub

Code :

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

1
2
3
4
5
6
7
8
9
10
Private Sub sendFormValuesToExcel()
    If (OptionS1 = True) Then
        Range("J2").FormulaR1C1 = OptionS1.Caption
        If (CheckBa = True) Then Range("K2").Value = "a"
        If (CheckBb = True) Then Range("K3").Value = "b"
    ElseIf (OptionS2 = True) Then
         Range("J2").FormulaR1C1 = OptionS2.Caption
    End If
 
End Sub

[MarcelG]

Salut,

Très bien.
Joins un fichier sans données confidentielles.

[Bell2018]

Bonjour MarcelG,

Voici mon fichier joins.
merci pour l'aide.

Filtre_avance.xlsm

[MarcelG]

Coucou Bell,

J'avais un professeur de mathématiques, en Terminale, qui faisait très souvent le parallèle entre un devoir de mathématiques et un devoir de français.
Il insistait notamment sur la clarté de l'exposé et le bon ordonnancement des méthodes.

Remarques:

1 - Comme partout ailleurs, la rigueur est nécessaire à la bonne nomenclature des contrôles.
Elle permet d'éviter les erreurs et, partant, d'envisager des boucles rendant le code à la fois plus souple et plus lisible. Comme ici.
Ainsi, j'ai renommé, entre autres, Chekc en CheckBc.
2 - Datevalue(Date) est redondant

Ici, j'ai créé 2 noms de cellules en J2 et K2.

Le code du formulaire ne se résume qu'à 3 procédures.

Tu remarqueras la valeur de la variable n qui a 2 objets:
- l'inscription des critères
- la définition de la zone de critères en fin de procédure

L'exécution du code est liée à l'activation du bouton de commande.

Tu consultes, tu comprends, tu appliques et tu reviens pour toute question.
J'ai enregistré le classeur. C'est volontairement que je ne te l'adresse pas, juste pour cet échange.

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
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
Option Explicit
 
Private Sub UserForm_Initialize()
    txtdate.Value = Date
End Sub
 
Private Sub Cmdfiltre_Click()
 
Call sendFormValuesToExcel
 
End Sub
 
Private Sub sendFormValuesToExcel()
 
Dim n As Byte
n = 0
 
Dim crit As Variant
 
With Worksheets("données")
 
        .Range("I2:O8").ClearContents
        .Range("W9:AC10000").ClearContents
 
        For Each crit In Array("S1", "S2")
                If Controls("Option" & crit) = True Then .Range("crit_semestre").Value = crit
        Next crit
 
        For Each crit In Array("a", "b", "c", "d", "e", "f")
                If Controls("CheckB" & crit) = True Then
                        n = n + 1
                        .Range("crit_groupe").Offset(n - 1).Value = crit
                End If
        Next crit
 
    .Range("Tableau1[#All]").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=.Range("I1").Resize(n + 1, 7), CopyToRange:=.Range("W9"), Unique:=False
 
End With
 
Unload Me
 
End Sub

[Bell2018]

Salut MarcelG,

Merci pour les remarques.

J'ai appliqué ton code mais je n'ai toujours pas de tri sur la plage CopyToRange, c'est toute la base de données qui reportée là bas.

Merci

[boisgontierjacques]

Bonjour,

Exemple de groupe d'options multiples avec ListBox

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
27
28
29
30
31
32
33
Option Compare Text
Dim TblBD()
Private Sub UserForm_Initialize()
  TblBD = [client].Value     ' pour rapidité
  TriMultiCol TblBD, 1, UBound(TblBD), 2
  Set d = CreateObject("scripting.dictionary")
  For i = 1 To [client].Rows.Count
    tmp = TblBD(i, 3): d(tmp) = ""
  Next i
  Me.OptionsGroupe.ListStyle = 1 'frmliststyleoption
  Tbl = d.keys
  Tri Tbl, LBound(Tbl), UBound(Tbl)
  Me.OptionsGroupe.List = Tbl
  Me.ListBox1.ColumnCount = [client].Columns.Count + 1
  Me.ListBox1.ColumnWidths = "60;50;30;50;100;70;70;50"
  Me.ListBox1.List = TblBD
End Sub
 
Private Sub OptionsGroupe_change()
  Set dchoisis1 = CreateObject("Scripting.Dictionary")
  For i = 0 To Me.OptionsGroupe.ListCount - 1
    If Me.OptionsGroupe.Selected(i) Then dchoisis1(Me.OptionsGroupe.List(i, 0)) = ""
  Next i
  Dim Tbl2(): n = 0: Ncol = UBound(TblBD, 2)
  For i = 1 To UBound(TblBD)
    tmp = TblBD(i, 3)
    If dchoisis1.exists(tmp) Then
        n = n + 1: ReDim Preserve Tbl2(1 To Ncol, 1 To n)
        For k = 1 To Ncol: Tbl2(k, n) = TblBD(i, k): Next k
    End If
  Next i
  If n > 0 Then Me.ListBox1.Column = Tbl2 Else Me.ListBox1.Clear
End Sub

Boisgontier

[Bell2018]

Bonjour boisgontierjacques,

merci déjà pour ton aide car c'est ce résultat que je recherche, mais avec la manière dont mon fichier est conçu.
Si tu pouvais me guider avec mon fichier, ça m'enlèverai un grand poids à mon projet.

[MarcelG]

Salut Jacques,

Comme Bell avait comme point de départ un filtre élaboré, j'ai développé en ce sens.
En tout cas,

Bell,
Je n'ai pas évoqué le tri.
Il n'y a donc pas matière à désespérer.

Avec le code que je t'ai proposé, le filtre s'exécute-t-il convenablement?
Des questions?
Pour le tri, tu peux t'aider de l'enregistreur de macro, à condition de l'épurer au maximum.

Reviens si nécessaire.
Le but est que tu intègres toutes les méthodes et propriétés incluses dans le code.

A plus. A moins que tu décides de naviguer vers d'autres cieux..., ce en quoi je ne verrais pas d'inconvénient. Tant pis pour moi.

[Bell2018]

En effet MarcelG le filtre n'est pas élaboré, car après que j'ai coché mes critères de filtre , je n'observe rien d'où mon véritable problème

[MarcelG]

Tu peux m'apostropher par "Marcel" ("G" est l'initiale de mon nom)

le filtre n'est pas élaboré

Si, si, il l'est.
C'est son exécution qui n'aboutit pas.

Je t'adresse le fichier en pièce jointe.
Surtout, tu comprends tout ce qui est reporté dans le code (méthodes et propriétés).

Reviens si nécessaire.

[boisgontierjacques]

Avec un groupe dynamique, on peut ajouter des groupes sans modifier le formulaire.
Faire une intersection de 2 listes avec le filtre élaboré est compliqué.

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
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
Option Compare Text
Dim TblBD(), dchoisis1, dchoisis2
Private Sub UserForm_Initialize()
  TblBD = [client].Value     ' pour rapidité
  TriMultiCol TblBD, 1, UBound(TblBD), 3
  Set d = CreateObject("scripting.dictionary")
  For i = 1 To [client].Rows.Count
    tmp = TblBD(i, 3): d(tmp) = ""
  Next i
  Me.OptionsGroupe.MultiSelect = fmMultiSelectMulti
  Me.OptionsGroupe.ListStyle = 1 'frmliststyleoption
  Tbl = d.keys
  Tri Tbl, LBound(Tbl), UBound(Tbl)
  Me.OptionsGroupe.List = Tbl
  '--
  Set d = CreateObject("scripting.dictionary")
  For i = 1 To [client].Rows.Count
    tmp = TblBD(i, 2): d(tmp) = ""
  Next i
  Me.OptionsSem.MultiSelect = fmMultiSelectMulti
  Me.OptionsSem.ListStyle = 1 'frmliststyleoption
  Me.OptionsSem.List = d.keys
  '--
  Me.ListBox1.ColumnCount = [client].Columns.Count + 1
  Me.ListBox1.ColumnWidths = "60;50;30;50;100;70;70;50"
  Me.ListBox1.List = TblBD
End Sub
 
Private Sub OptionsGroupe_change()
  Affiche
End Sub
 
Private Sub OptionsSem_change()
  Affiche
End Sub
 
Sub Affiche()
  Set dchoisis1 = CreateObject("Scripting.Dictionary")
  For i = 0 To Me.OptionsGroupe.ListCount - 1
    If Me.OptionsGroupe.Selected(i) Then dchoisis1(Me.OptionsGroupe.List(i, 0)) = ""
  Next i
  Set dchoisis2 = CreateObject("Scripting.Dictionary")
  For i = 0 To Me.OptionsSem.ListCount - 1
    If Me.OptionsSem.Selected(i) Then dchoisis2(Me.OptionsSem.List(i, 0)) = ""
  Next i
  Dim Tbl2(): n = 0: Ncol = UBound(TblBD, 2)
  For i = 1 To UBound(TblBD)
    tmp = TblBD(i, 3): tmp2 = TblBD(i, 2)
    If dchoisis1.exists(tmp) And dchoisis2.exists(tmp2) Then
        n = n + 1: ReDim Preserve Tbl2(1 To Ncol, 1 To n)
        For k = 1 To Ncol: Tbl2(k, n) = TblBD(i, k): Next k
    End If
  Next i
  If n > 0 Then Me.ListBox1.Column = Tbl2 Else Me.ListBox1.Clear
End Sub

Boisgontier

[MarcelG]

Cela dépasse l'entendement.

Preuve, s'il en est, que la technicité n'est pas forcément reflétée par la qualité quantifiée de l'intervenant.
Pour preuve
- MarcelG = Expert confirmé
- Jacques Boisgontier = Membre Chevronné

Alors que, comme on dit, "il n'y a pas photo".

[Bell2018]

merci Jacques,Marcel, j'ai trouvé mon erreur finalement qui était au niveau de la plage de réception du filtre.

Cependant j'ai une autre préoccupation le filtre s'exécute bien au niveau des groupes mais pas des semestres.

car lorsque je coche "S1" et "groupe a", "groupe b" j'ai tous les étudiants appartenant à ses groupes des" S1"et "S2", alors que je veux juste ceux de "S1"

[boisgontierjacques]

Une façon simple avec le filtre auto.

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
 
Sub Filtre()
  Application.ScreenUpdating = False
  On Error Resume Next
  ActiveSheet.ShowAllData
   '--- groupe
   n = Application.CountA([C2:C8])
   If n > 0 Then
     Tbl = Application.Transpose([C2].Resize(n))
     ActiveSheet.[A10].AutoFilter Field:=3, Criteria1:=Tbl, Operator:=xlFilterValues
   End If
   '--- semestre
   n = Application.CountA([b2:B3])
   If n > 0 Then
     Tbl = Application.Transpose([b2].Resize(n))
     ActiveSheet.[A10].AutoFilter Field:=2, Criteria1:=Tbl, Operator:=xlFilterValues
   End If
End Sub

Boisgontier