Enlever les filtre sur excel via vba

Version imprimable

06/06/2017, 14h22
rom1deh

Enlever les filtre sur excel via vba

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:

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
06/06/2017, 14h26
78chris

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...
06/06/2017, 14h31
paul_thms
Citation:

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:

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:

1 2 Cells.select Selection.AutoFilter
06/06/2017, 14h59
jerome.vaussenat

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:

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 !

Bonsoir à tous
Voir coté enregistreur Automatique :aie:
qui donne a peu près ça :
Code:

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

2 pièce(s) jointe(s)

code vba

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:

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

UserformPièce jointe 282897
Je voudrais filtrer défiltrer la colone B4Pièce jointe 282902

Cordialement

07/06/2017, 16h41
rom1deh
Citation:
Envoyé par BENNASR

Bonsoir à tous
Voir coté enregistreur Automatique :aie:
qui donne a peu près ça :

Code:

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
07/06/2017, 18h15
rom1deh

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
26/08/2018, 17h44
eriiic

Bonjour,

merci BENNASR, je trouvais pas... :plusser:
eric

1 pièce(s) jointe(s)

Enlever les filtres sans MAJ scren

Bonjour,

Je cherche à désactiver le rafraîchissement de l'écran lors de l’exécution de ma macro.
Mais au moment où showalldata s’exécute le rafraîchissement se fait quand même...

L'idée c'est de trier une colonne, exécuter la macro (test ou test 2) et que le rafraîchissement ne se fasse que lorsque la macro est terminée.

Pouvez-vous m'aider?

Code:

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
Sub test()
 
    Application.ScreenUpdating = False 'Désactivation du raffraichissement de l'écran
 
With ActiveSheet
    If .FilterMode = True Then .FilterMode = False 'supprime les filtres de la feuille
End With
 
    Application.ScreenUpdating = True 'activation du raffraichissement de l'écran
 
End Sub
 
Sub test2()
 
    Application.ScreenUpdating = False 'Désactivation du raffraichissement de l'écran
 
    With ActiveSheet
        If .AutoFilterMode Then
            .Cells.AutoFilter
        End If
    End With
 
   With ActiveSheet
        If Not .AutoFilterMode Then
            .Cells.AutoFilter
        End If
    End With
 
    Application.ScreenUpdating = True 'activation du raffraichissement de l'écran
 
End Sub