Relier les différents filtres

**Patouillou** · 29/10/2016, 01h03

Bonjour, je dispose actuellement d'une base de données qui me sert pour travailler et j’essaie d'y ajouter un bouton "stat" .
Celui-ci me permettrait de filtrer les valeurs de mon tableau à partir de plusieurs Combobox et d'un TextBox.
Aujourd'hui, je me suis servis de ce que j'ai pus trouver et j'ai réussi a faire mes filtres.. Mon problème étant que je ne peux en sélectionner qu'un seul,
puisque que quand je sélectionne un autre , le dernier n'est pas pris en compte.
Je voulais donc vous demander comment je pourrait faire pour relier le tout

Voici les code de mon UseeForm:

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
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
Private O As Worksheet 'déclare la variable O (Onglet)
Private TC As Variant 'déclare la variable TC (Tableau de Cellules)
Private NL As Integer 'déclare la variable NL (Nombre de Lignes)
Private NC As Integer 'déclare la variable NC (Nombre de Colonnes)
 
Private Sub UserForm_Initialize()
Me.ListBox1.ColumnCount = 10
ComboBox1.List() = Array("", "CAEN", "ROUEN", "ANGERS", "LE MANS", "TOURS", "POITIERS", "NANTES", "RENNES", "BREST", "BORDEAUX")
ComboBox2.List() = Array("", "$$$$$$$", "ùùùùùù", "******", "^^^^^^", "!!!!!!!", "::::::")
 
 
Set O = Sheets("RECAPITULATIF") 'définit l'onglet O
TC = O.Cells(2, 1).Resize(O.UsedRange.Rows.Count - 2, 17) 'définit le tableau de cellules TC
NL = UBound(TC, 1) 'définit le nombre de ligne NL
NC = 10 'définit le nombre de colonnes NC
Me.ListBox1.ColumnCount = NC 'définit le nombre de colonne de la ListBox1
End Sub
 
Private Sub TextBox1_Change() 'au changement dans la Textbox1
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable J (incrément)
Dim K As Integer 'déclare la variable L (incrément)
Dim TOT() As Variant 'déclare la variable TOT (Tableau des Occcurrences Trouvées)
Dim L As Integer 'déclare la variable L (incrément)
 
 
 
 
K = 1 'initialise la variable K
For I = 2 To NL 'boucle 1 : sur toutes les lignes I du tableau de cellule TC (en partant de la seconde)
    For J = 10 To 10 'boucle 2 : sur toutes les colonnes J du tableau de cellules TC
        'condition : si la valeur de la TetxBox1 est contenue dans la valeur ligne I colonne J de TC
        If UCase(TC(I, J)) Like "*" & UCase(Me.TextBox1.Value) & "*" Then
            'redimensionne le tableau des occurrences trouvées TOT (autant de lignes que TC a de colonnes, K colonnes)
            ReDim Preserve TOT(1 To NC, 1 To K)
            For L = 1 To NC 'boucle 3 : sur toutes les colonnes de TC
                TOT(L, K) = TC(I, L) 'alimente la ligne du tableau TOT avec la colonne du tableau TC
            Next L 'prochaine colonne de la boucle 3
            K = K + 1 'incrémete K (nouvelle colonne pour TOT)
            Exit For 'sort de la boucle 2
        End If 'fin de la condition
    Next J 'prochaine colonne de la boucle 2
Next I 'prochaine ligne de la boucle 1
On Error Resume Next 'gestion des erreur (en cas d'erreur passe à la ligne suivante)
'si le tableau TOT ne contient qu'une seule ligne, ajoute une seconde ligne vide (sinon les données sans dans une seule colonne...)
If UBound(TOT, 2) = 1 Then ReDim Preserve TOT(1 To NC, 1 To 2)
'alimente la ListBox1 avec le tableau TOT transposé (ligne/Colonne)
Me.ListBox1.List = Application.Transpose(TOT) 'génère une erreur si TOT est vide
End Sub
Private Sub ComboBox1_Change() 'au changement dans la Textbox1
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable J (incrément)
Dim K As Integer 'déclare la variable L (incrément)
Dim TOT() As Variant 'déclare la variable TOT (Tableau des Occcurrences Trouvées)
Dim L As Integer 'déclare la variable L (incrément)
 
 
K = 1 'initialise la variable K
For I = 2 To NL 'boucle 1 : sur toutes les lignes I du tableau de cellule TC (en partant de la seconde)
    For J = 3 To 3 'boucle 2 : sur toutes les colonnes J du tableau de cellules TC
        'condition : si la valeur de la TetxBox1 est contenue dans la valeur ligne I colonne J de TC
        If UCase(TC(I, J)) Like "*" & UCase(Me.ComboBox1.Value) & "*" Then
            'redimensionne le tableau des occurrences trouvées TOT (autant de lignes que TC a de colonnes, K colonnes)
            ReDim Preserve TOT(1 To NC, 1 To K)
            For L = 1 To NC 'boucle 3 : sur toutes les colonnes de TC
                TOT(L, K) = TC(I, L) 'alimente la ligne du tableau TOT avec la colonne du tableau TC
            Next L 'prochaine colonne de la boucle 3
            K = K + 1 'incrémete K (nouvelle colonne pour TOT)
            Exit For 'sort de la boucle 2
        End If 'fin de la condition
    Next J 'prochaine colonne de la boucle 2
Next I 'prochaine ligne de la boucle 1
On Error Resume Next 'gestion des erreur (en cas d'erreur passe à la ligne suivante)
'si le tableau TOT ne contient qu'une seule ligne, ajoute une seconde ligne vide (sinon les données sans dans une seule colonne...)
If UBound(TOT, 2) = 1 Then ReDim Preserve TOT(1 To NC, 1 To 2)
'alimente la ListBox1 avec le tableau TOT transposé (ligne/Colonne)
Me.ListBox1.List = Application.Transpose(TOT) 'génère une erreur si TOT est vide
End Sub
 
Private Sub ComboBox2_Change() 'au changement dans la Textbox1
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable J (incrément)
Dim K As Integer 'déclare la variable L (incrément)
Dim TOT() As Variant 'déclare la variable TOT (Tableau des Occcurrences Trouvées)
Dim L As Integer 'déclare la variable L (incrément)
 
 
K = 1 'initialise la variable K
For I = 2 To NL 'boucle 1 : sur toutes les lignes I du tableau de cellule TC (en partant de la seconde)
    For J = 6 To 6 'boucle 2 : sur toutes les colonnes J du tableau de cellules TC
        'condition : si la valeur de la TetxBox1 est contenue dans la valeur ligne I colonne J de TC
        If UCase(TC(I, J)) Like "*" & UCase(Me.ComboBox2.Value) & "*" Then
            'redimensionne le tableau des occurrences trouvées TOT (autant de lignes que TC a de colonnes, K colonnes)
            ReDim Preserve TOT(1 To NC, 1 To K)
            For L = 1 To NC 'boucle 3 : sur toutes les colonnes de TC
                TOT(L, K) = TC(I, L) 'alimente la ligne du tableau TOT avec la colonne du tableau TC
            Next L 'prochaine colonne de la boucle 3
            K = K + 1 'incrémete K (nouvelle colonne pour TOT)
            Exit For 'sort de la boucle 2
        End If 'fin de la condition
    Next J 'prochaine colonne de la boucle 2
Next I 'prochaine ligne de la boucle 1
On Error Resume Next 'gestion des erreur (en cas d'erreur passe à la ligne suivante)
'si le tableau TOT ne contient qu'une seule ligne, ajoute une seconde ligne vide (sinon les données sans dans une seule colonne...)
If UBound(TOT, 2) = 1 Then ReDim Preserve TOT(1 To NC, 1 To 2)
'alimente la ListBox1 avec le tableau TOT transposé (ligne/Colonne)
Me.ListBox1.List = Application.Transpose(TOT) 'génère une erreur si TOT est vide
End Sub

Merci de votre aide !!!
Cordialement,

**joe.levrai** · 29/10/2016, 12h36

Bonjour,

une méthode possible proposée hier : http://www.developpez.net/forums/d16...s/#post8781485

**Patouillou** · 29/10/2016, 15h33

Bonjour, j'ai regardé ton code d'hier , j'ai remplacer par ce qu'il me allait mais voilà, quand je sectionne dans mes combobox1 et 2 (renouées texbox2 et3 ) ou encore quand je rentre une date quelquonque dans la texbox , rien ne se passe , la listbox est vide...
De plus , je n'arrive pas a faire en sorte que la plage de donnée aille de A3 à Sdernière cellule non vide ...
Merci de votre aide
Cordialement,

Voici le code actuel:

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
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
Option Compare Text
Dim a
Dim O, choix()
 
' ICI ON APPELLE JUSTE LA METHODE GLOBALE DE FILTRAGE
Private Sub TextBox1_Change()
    FiltreMonListBox Me.ListBox1
End Sub
 
Private Sub TextBox2_Change()
    FiltreMonListBox Me.ListBox1
End Sub
 
Private Sub TextBox3_Change()
    FiltreMonListBox Me.ListBox1
End Sub
 
Private Sub UserForm_Initialize()
Me.ListBox1.ColumnCount = 10
TextBox2.List() = Array("", "CAEN", "ROUEN", "ANGERS", "LE MANS", "TOURS", "POITIERS", "NANTES", "RENNES", "BREST", "BORDEAUX")
TextBox3.List() = Array("", "erty", "dgshS", "ergerg", "rgerh", "regerg", "rehsh")
 
 
 
Set O = Sheets("RECAPITULATIF") 'définit l'onglet O
 a = Cells(1, 1).CurrentRegion.Value
RempliMonListBox Me.ListBox1
 
 
End Sub
 
 
 
 
 
 
' LA METHODE QUI EFFECTUE LE FILTRAGE
Private Sub FiltreMonListBox(LeListBox As msforms.ListBox)
Dim LesFiltres As String, Nb_Filtres As Long
    ' vidage et remplissage complet
    RempliMonListBox LeListBox
 
    ' on prend le critère de filtrage de chacune des trois textbox (si elle ne sont pas vides
    For i = 1 To 3
        If Me.Controls("TextBox" & i).Text <> "" Then LesFiltres = Me.Controls("TextBox" & i).Text & "$" & LesFiltres
    Next i
 
    ' on regarde combien de critères à analyser
    Nb_Filtres = UBound(Split(LesFiltres, "$"))
 
    ' s'il y a des critères
    If Nb_Filtres > 0 Then
        With LeListBox
            ' pour chaque élément de ListBox
            For J = .ListCount To 1 Step -1
                ' pour chaque filtrage souhaité
                For i = 0 To Nb_Filtres - 1
                    ' on regarde si le critère de filtrage existe dans l'élément de ListBox testé
                    If Not ExisteDans(Split(LesFiltres, "$")(i), .List(J - 1)) Then
                        ' s'il n'existe pas, on supprime l'élément
                        .RemoveItem (J - 1)
                        Exit For
                    End If
                Next i
            Next J
        End With
    End If
End Sub
 
 
' VIDAGE ET REMPLISSAGE DU LISTBOX
Private Sub RempliMonListBox(LeListBox As msforms.ListBox)
    With LeListBox
        .Clear
        .List = a
    End With
End Sub
 
' FONCTION QUI VERIFIE SI UNE SOUS-CHAINE EXISTE DANS UNE CHAINE
Function ExisteDans(ByVal LaChaine As String, ByVal ItemDuListBox As String) As Boolean
    ExisteDans = InStr(1, ItemDuListBox, LaChaine) > 0
End Function

Relier les différents filtres

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager