Enlever les filtre sur excel via vba

**rom1deh** · 06/06/2017, 14h22

Bonjour à tous,

Je viens vers vous car j'ai des difficultés pour enlever un filtre sur une colonne.

J'ai crée une interface pour procéder a des recherches rapides mais je n'arrive pas à enlever un filtre.

J'ai utiliser

Code :

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

ActiveSheet.ShowAllData

mais sans succès j'ai des codes erreurs diverses selon mes modifs.

je vous joins le fichier en question.

Bonne journée à vous,

Cordialement

Romain

**78chris** · 06/06/2017, 14h26

Bonjour

En cas d'utilisation de tableau (listobject) il faut que la cellule active se trouve dans le tableau et dans tout les cas vérifier qu'un filtre est actif.

Edit : puisque tu manipules un listobject utilise la VBA fait pour plutôt qu'une approche plage classique, comme pour le calcul du nombre de lignes par exemple...

**paul_thms** · 06/06/2017, 14h31

Envoyé par rom1deh

Bonjour à tous,

Je viens vers vous car j'ai des difficultés pour enlever un filtre sur une colonne.

J'ai crée une interface pour procéder a des recherches rapides mais je n'arrive pas à enlever un filtre.

J'ai utiliser

Code :

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

ActiveSheet.ShowAllData

mais sans succès j'ai des codes erreurs diverses selon mes modifs.

je vous joins le fichier en question.

Bonne journée à vous,

Cordialement

Romain

Essaye avec

Code :

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

1
2
Cells.select
Selection.AutoFilter

**jerome.vaussenat** · 06/06/2017, 14h59

Salut,

comme le dit 78chris, tu ne peux pas effacer un filtre si ton tableau n'est pas filtré au préalable.

Pour éviter l'affichage des fenêtres d'erreur lors de l'exécution de ton code, tu peux ajouter cette ligne au début de ton code.

Code :

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

    On Error Resume Next

Attention, c'est juste pour le cas où tu lances la macro et qu'il n'y a pas de filtre actif. C'est plus "propre".

Après il faut voir ton code. mais, comme beaucoup de personnes sur ce site, j'évite d'ouvrir les fichiers joints et encore plus quand se sont des XLSM.

Si tu veux qu'on voie ton code, colle le dans un poste ET SURTOUT utilise le bouton # pour indiquer que c'est un code. Pour les lecteurs, c'est plus lisible. comme tu le vois ci dessus !

**BENNASR** · 06/06/2017, 15h00

Bonsoir à tous
Voir coté enregistreur Automatique

qui donne a peu près ça :

Code :

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

1
2
3
4
5
6
7
Sub tt()
On Error Resume Next
With Sheets("DONNEES")
.Activate
  ActiveSheet.ListObjects("Tableau1").Range.AutoFilter
End With
End Sub

**rom1deh** · 06/06/2017, 15h31

Après je suis sur le réseau de mon entreprise à vrais dire le risque est plus mesuré niveau virus.

Voila le codage

Oui je suis bien dans un tableau quand je filtre ma selection je vois bien mon filtre se faire. Mais celui-ci ne se désactive pas

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
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
Option Explicit
Private Sub CbCaract_Change()
Application.ScreenUpdating = False
If CbCaract <> "" Then
Sheets("DONNEES").Activate
    ActiveSheet.Range("$A$4:$R$4").AutoFilter Field:=2, Criteria1:=CbCaract
    Else
        Sheets("DONNEES").Activate
       Sheets("DONNEES").ShowAllData
    End If
        With UfAnalysedhuile
        .Label50.Caption = Sheets("DONNEES").Range("C" & Rows.Count).End(xlUp).Rows
        .Label43.Caption = Sheets("DONNEES").Range("I" & Rows.Count).End(xlUp).Rows
            If Val(Label43.Caption) <= 130 Then
                UfAnalysedhuile.Label43.BackColor = RGB(225, 0, 0)
            Else
                UfAnalysedhuile.Label43.BackColor = &H80000003
            End If
        .Label40.Caption = Sheets("DONNEES").Range("J" & Rows.Count).End(xlUp).Rows
                    If Val(Label40.Caption) <= 41.4 Then
                UfAnalysedhuile.Label40.BackColor = RGB(225, 0, 0)
            Else
                UfAnalysedhuile.Label40.BackColor = &H80000003
            End If
        .Label41.Caption = Sheets("DONNEES").Range("K" & Rows.Count).End(xlUp).Rows
                    If Val(Label41.Caption) <= 7.92 Then
                UfAnalysedhuile.Label41.BackColor = RGB(225, 0, 0)
            Else
                UfAnalysedhuile.Label41.BackColor = &H80000003
            End If
        .Label19.Caption = Sheets("DONNEES").Range("L" & Rows.Count).End(xlUp).Rows
            If Val(Label19.Caption) > 18 Then
                UfAnalysedhuile.Label19.BackColor = RGB(225, 0, 0)
            Else
                UfAnalysedhuile.Label19.BackColor = &H80000003
            End If
    .Label17.Caption = Sheets("DONNEES").Range("M" & Rows.Count).End(xlUp).Rows
            If Val(Label17.Caption) > 16 Then
                UfAnalysedhuile.Label17.BackColor = RGB(225, 0, 0)
            Else
                UfAnalysedhuile.Label17.BackColor = &H80000003
            End If
    .Label18.Caption = Sheets("DONNEES").Range("N" & Rows.Count).End(xlUp).Rows
            If Val(Label18.Caption) > 13 Then
                UfAnalysedhuile.Label18.BackColor = RGB(225, 0, 0)
            Else
                UfAnalysedhuile.Label18.BackColor = &H80000003
            End If
     End With
Application.ScreenUpdating = True
End Sub
 
Private Sub CbListe_Change()
 
Application.ScreenUpdating = False
    If CbListe <> "" Then
        Sheets("DONNEES").Activate
        ActiveSheet.Range("$A$4:$R$4").AutoFilter Field:=2, Criteria1:=CbListe
    Else
        Sheets("DONNEES").Activate
        ActiveSheet.ShowAllData
    End If
 
    With UfAnalysedhuile
        .Label51.Caption = Sheets("DONNEES").Range("C" & Rows.Count).End(xlUp).Rows
        .Label37.Caption = Sheets("DONNEES").Range("I" & Rows.Count).End(xlUp).Rows
            If Val(Label37.Caption) <= 130 Then
                UfAnalysedhuile.Label37.BackColor = RGB(225, 0, 0)
            Else
                UfAnalysedhuile.Label37.BackColor = &H80000003
            End If
        .Label12.Caption = Sheets("DONNEES").Range("J" & Rows.Count).End(xlUp).Rows
                    If Val(Label12.Caption) <= 41.4 Then
                UfAnalysedhuile.Label12.BackColor = RGB(225, 0, 0)
            Else
                UfAnalysedhuile.Label12.BackColor = &H80000003
            End If
        .Label13.Caption = Sheets("DONNEES").Range("K" & Rows.Count).End(xlUp).Rows
                    If Val(Label13.Caption) <= 7.92 Then
                UfAnalysedhuile.Label13.BackColor = RGB(225, 0, 0)
            Else
                UfAnalysedhuile.Label13.BackColor = &H80000003
            End If
        .Lbl4µm.Caption = Sheets("DONNEES").Range("L" & Rows.Count).End(xlUp).Rows
            If Val(Lbl4µm.Caption) > 18 Then
                UfAnalysedhuile.Lbl4µm.BackColor = RGB(225, 0, 0)
            Else
                UfAnalysedhuile.Lbl4µm.BackColor = &H80000003
            End If
    .Lbl6µm.Caption = Sheets("DONNEES").Range("M" & Rows.Count).End(xlUp).Rows
            If Val(Lbl6µm.Caption) > 16 Then
                UfAnalysedhuile.Lbl6µm.BackColor = RGB(225, 0, 0)
            Else
                UfAnalysedhuile.Lbl6µm.BackColor = &H80000003
            End If
    .Lbl14µm.Caption = Sheets("DONNEES").Range("N" & Rows.Count).End(xlUp).Rows
            If Val(Lbl14µm.Caption) > 13 Then
                UfAnalysedhuile.Lbl14µm.BackColor = RGB(225, 0, 0)
            Else
                UfAnalysedhuile.Lbl14µm.BackColor = &H80000003
            End If
     End With
Application.ScreenUpdating = True
End Sub
Private Sub CbPower_Change()
If CbPower <> "" Then
        Sheets("DONNEES").Activate
        ActiveSheet.Range("$A$4:$R$4").AutoFilter Field:=2, Criteria1:=CbPower
    Else
        Sheets("DONNEES").Activate
        ActiveSheet.ShowAllData
    End If
        With UfAnalysedhuile
        .Label52.Caption = Sheets("DONNEES").Range("C" & Rows.Count).End(xlUp).Rows
        .Label49.Caption = Sheets("DONNEES").Range("I" & Rows.Count).End(xlUp).Rows
            If Val(Label49.Caption) <= 205 Then
                UfAnalysedhuile.Label49.BackColor = RGB(225, 0, 0)
            Else
                UfAnalysedhuile.Label49.BackColor = &H80000003
            End If
        .Label46.Caption = Sheets("DONNEES").Range("J" & Rows.Count).End(xlUp).Rows
                    If Val(Label46.Caption) <= 27.54 Then
                UfAnalysedhuile.Label46.BackColor = RGB(225, 0, 0)
            Else
                UfAnalysedhuile.Label46.BackColor = &H80000003
            End If
        .Label47.Caption = Sheets("DONNEES").Range("K" & Rows.Count).End(xlUp).Rows
                    If Val(Label47.Caption) <= 7.72 Then
                UfAnalysedhuile.Label47.BackColor = RGB(225, 0, 0)
            Else
                UfAnalysedhuile.Label47.BackColor = &H80000003
            End If
        .Label31.Caption = Sheets("DONNEES").Range("L" & Rows.Count).End(xlUp).Rows
            If Val(Label31.Caption) > 18 Then
                UfAnalysedhuile.Label31.BackColor = RGB(225, 0, 0)
            Else
                UfAnalysedhuile.Label31.BackColor = &H80000003
            End If
        .Label29.Caption = Sheets("DONNEES").Range("M" & Rows.Count).End(xlUp).Rows
            If Val(Label29.Caption) > 16 Then
                UfAnalysedhuile.Label29.BackColor = RGB(225, 0, 0)
            Else
                UfAnalysedhuile.Label29.BackColor = &H80000003
            End If
        .Label30.Caption = Sheets("DONNEES").Range("N" & Rows.Count).End(xlUp).Rows
            If Val(Label30.Caption) > 13 Then
                UfAnalysedhuile.Label30.BackColor = RGB(225, 0, 0)
            Else
                UfAnalysedhuile.Label30.BackColor = &H80000003
            End If
     End With
Application.ScreenUpdating = True
End Sub
 
Private Sub CbReset_Click()
With UfAnalysedhuile
    .CbListe = ""
    .Lbl4µm = ""
    .Lbl6µm = ""
    .Lbl14µm = ""
    .Label12 = ""
    .Label13 = ""
    .Label37 = ""
    .Label51 = ""
    .Lbl4µm.BackColor = &H80000003
    .Lbl6µm.BackColor = &H80000003
    .Lbl14µm.BackColor = &H80000003
    .Label12.BackColor = &H80000003
    .Label13.BackColor = &H80000003
    .Label37.BackColor = &H80000003
    End With
    Worksheets("DONNEES").AutoFilterMode = False
 
End Sub
 
Private Sub CommandButton1_Click()
    With UfAnalysedhuile
    .CbCaract = ""
    .Label19 = ""
    .Label17 = ""
    .Label18 = ""
    .Label40 = ""
    .Label41 = ""
    .Label43 = ""
    .Label50 = ""
    .Label19.BackColor = &H80000003
    .Label17.BackColor = &H80000003
    .Label18.BackColor = &H80000003
    .Label40.BackColor = &H80000003
    .Label41.BackColor = &H80000003
    .Label43.BackColor = &H80000003
    End With
    Worksheets("DONNEES").AutoFilterMode = False
End Sub
Private Sub CommandButton2_Click()
With UfAnalysedhuile
    .CbPower = ""
    .Label31 = ""
    .Label29 = ""
    .Label30 = ""
    .Label46 = ""
    .Label47 = ""
    .Label49 = ""
    .Label50 = ""
    .Label31.BackColor = &H80000003
    .Label29.BackColor = &H80000003
    .Label30.BackColor = &H80000003
    .Label46.BackColor = &H80000003
    .Label47.BackColor = &H80000003
    .Label49.BackColor = &H80000003
    End With
    Worksheets("DONNEES").AutoFilterMode = False
End Sub
 
 
Private Sub UserForm_Initialize()
Dim I As Byte
Dim J As Byte
Dim K As Byte
    With Sheets("Liste")
        For I = 2 To .Range("A" & Rows.Count).End(xlUp).Row  'Liste des bancs de la feuille "Liste"
            CbListe.AddItem .Cells(I, 1)
        Next
        For J = 2 To .Range("C" & Rows.Count).End(xlUp).Row  'Liste des bancs de la feuille "Liste"
            CbCaract.AddItem .Cells(J, 3)
        Next
        For K = 2 To .Range("C" & Rows.Count).End(xlUp).Row  'Liste des bancs de la feuille "Liste"
            CbPower.AddItem .Cells(K, 5)
        Next
    End With
End Sub

Userform

Nom : Capture213.PNG
Affichages : 14339
Taille : 42,7 Ko

Je voudrais filtrer défiltrer la colone B4 Nom : Capture.1231.PNG
Affichages : 14329
Taille : 36,4 Ko

Cordialement

**rom1deh** · 07/06/2017, 16h41

Envoyé par BENNASR

Bonsoir à tous
Voir coté enregistreur Automatique

qui donne a peu près ça :

Code :

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

1
2
3
4
5
6
7
Sub tt()
On Error Resume Next
With Sheets("DONNEES")
.Activate
  ActiveSheet.ListObjects("Tableau1").Range.AutoFilter
End With
End Sub

J'ai essayer d'adapter ton code mais sans succès. je ne suis pas du tout à l'aise avec les filtres

**rom1deh** · 07/06/2017, 18h15

Je viens de m'apercevoir mis à pars que mon code bug pour désactiver le filtre.

Celui ci me donne pas la bonne valeur dans mes labels.

Je m'explique

quand je filtre je veux récupéré la dernière valeur de la ligne active dans certaine cellule.

hors al filtre ou non je récupère ma dernière ligne non tout cours

**eriiic** · 26/08/2018, 17h44

Bonjour,

merci BENNASR, je trouvais pas...

eric

Enlever les filtre sur excel via vba [XL-2010]

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager