Utiliser les filtres avec une macro VBA

Version imprimable

03/05/2016, 18h24
levothy

1 pièce(s) jointe(s)

Utiliser les filtres avec une macro VBA

Bonjour à tous;

Urgent besoin d'aide.
Je suis également débutante en vba, cela dit j'essaye de m'améliorer ;)

voici ci joint mon fichier, il s'agit de gestion de maintenance préventive. Ma macro maintenance fonctionne relativement bien si le fichier n'est pas trop lourd (peu de lignes). Par contre cela rame avec un nombre important de lignes (3000 environ).
Je souhaite donc utiliser des filtres sur ma feuille PMP_2016, puis lancer ma macro en fonction des filtres ajoutés (par exemple code atelier BREBIOU et année 2016 dans date de la prochaine intervention).
En résumé je souhaite que ma macro se lance que pour les lignes sélectionnées via les filtres.

Merci à vous

fab
04/05/2016, 12h16
Menhir

Citation:

Envoyé par levothy

voici ci joint mon fichier

http://www.developpez.net/forums/d84...s-discussions/

Citation:

En résumé je souhaite que ma macro se lance que pour les lignes sélectionnées via les filtres.

Pour sélectionner uniquement les cellules visibles, le plus pratique est d'utiliser la méthode SpecialCells(xlCellTypeVisible) de l'objet Range appliqué à la colonne où se trouve les données à traiter.
https://msdn.microsoft.com/fr-fr/lib.../ff196157.aspx

Tu peux utiliser ceci pour t'inspirer.
Code:

1 2 3 4 5 6 Sub () With Range(Range("A1"), Range("C4000").End(xlUp)) .AutoFilter Field:=1, Criteria1:="2016" .SpecialCells(xlCellTypeVisible).EntireRow.select End With End Sub
Cette macro permet de sélectionner toutes les lignes contenant 2016 dans ta plage de données.

Merci à vous deux

j'ai essayé de modifier mon sub maintenance comme suit, mais cela bug 8O

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
Sub Maintenance()    'chaque clique ou chaque changement de cellule
 
nom_feuille = ActiveWorkbook.ActiveSheet.Name                  'recuperation du nom de la feuille
If ActiveCell.Column = 8 Or ActiveCell.Column = 7 Or ActiveCell.Column = 16 Or ActiveCell.Column = 9 Or ActiveCell.Column = 19 Then Exit Sub 'la macro n'est pas réalisée lorsque l'on clique dans les colonne G et H
If sortie_macro = 1 Then Exit Sub
 
'initialisation des variables
t = 0
aujourdhui = Date
lignetitre = 8
lastmaint = "P"
nextmaint = "Q"
typefreq = "O"
freq = "N"
i = lignetitre
freq1 = "jour"
freq2 = "mois"
freq3 = "an"
freq4 = "cycle"
 
message_alerte = 0
pre_alerte = -7                                            'message alerte s'affiche tant de jour(s) avant la date de la prochaine maintenance
 
Application.ScreenUpdating = False
Range(Range("A" & Rows.Count).End(xlUp), Cells(8, 1)).Select
 
'on place dans un tableau les N° de lignes visibles
For Each cellule In Selection.SpecialCells(xlCellTypeVisible)
On Error Resume Next
Tablo.Add cellule.Row, CStr(cellule.Row)
Next cellule
 
'initialisation du message d'erreur
 
Msg = "Au moins une des opérations doit être envisagée dans les " & Abs(pre_alerte) & " prochains jours. Voulez-vous accedez à la premiere intervention ?"   ' Définit le message.
Style = vbYesNo + vbCritical + vbDefaultButton2                 'Définit les boutons.
Title = "Message d'ALERTE "                                     'Définit le titre.
 
 
'on reprend les N° de lignes depuis la fin du tableau
For N = Tablo.Count To 0 Step -1
 
 
    celltypefreq = typefreq & N                                 'cellule à lire
    If Range(celltypefreq) = freq1 Then decalage = "d"          'determination du type de décalage determiné par le type de fréquence
    If Range(celltypefreq) = freq2 Then decalage = "m"         'determination du type de décalage determiné par le type de fréquence
    If Range(celltypefreq) = freq3 Then decalage = "yyyy"       'determination du type de décalage determiné par le type de fréquence
    If Range(celltypefreq) = freq4 Then                         'écrit "suivant fréquence" dans cellule "date prochaine maintenance"
             celldatnextmaint = nextmaint & N: Range(celldatnextmaint).Value = "suivant frequence": GoTo ligne1
    End If                                                      'à modifier suivant le type de fréquence
    'calcul de la prochaine date de maintenance
    cellfreq = freq & N                                         'cellule à lire
    datelastmaint = DateValue(Cells(N, lastmaint).Value)        'mise en forme de la date de la derniere maintenance
    nbrefreq = Range(cellfreq).Value                            'récuperation de la fréquence
    journextmaint = DateAdd(decalage, nbrefreq, datelastmaint)  'calcul du jour de la prochaine maintenance
 
    celldatnextmaint = nextmaint & N                            'cellule de destination
    Range(celldatnextmaint).Value = journextmaint               'écriture dans la cellule de destination
 
    date_alerte = DateAdd("d", pre_alerte, journextmaint)
    If aujourdhui >= date_alerte Then message_alerte = 1: tabrep(t) = N: t = t + 1    'test pour message d'alerte, on met message_alerte à 1 si au
                                                                                        'moins une date dépassée, on met le numéro de ligne dans le tableau
                                                                                        'tabrep à la position t
ligne1:
Next
'Application.ScreenUpdating = True
If message_alerte = 1 Then Reponse = MsgBox(Msg, Style, Title) 'affichage du message
 
postabrep = 0                                                  'initilaisation de la position dans le tableau tabrep()
premierelignemauvaise = lastmaint & tabrep(postabrep)          'position de la premiere cellule rouge
If Reponse = vbYes Then sortie_macro = 1: affichage_messages
sortie_macro = 0
End Sub

Pourriez vous m'indiquer où est l'erreur
merci pour votre aide

04/05/2016, 14h22
Menhir

Citation:

Envoyé par levothy

j'ai essayé de modifier mon sub maintenance comme suit, mais cela bug 8O

Surtout ne prend pas la peine de décrire le problème... "cela bug", c'est tellement clair comme description. :roll:

Qu'est-ce qui se passe ? Quelle est le message d'erreur affiché ? Sur quelle ligne se produit le bug ?

Autre conseil : quand tu mets du code dans un message, encadre-le des balise CODE (l'icone # dans l'éditeur).

1 pièce(s) jointe(s)

ok Menhir, merci pour le conseil, sans les filtres cela fonctionne quand on utilise la boucle do, mais pour un nombre restreint de lignes. Je ne sais pas comment faire cette même boucle en utilisant uniquement les cellules filtrées.
voici le message d'erreur

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
Sub Maintenance()    'chaque clique ou chaque changement de cellule
 
nom_feuille = ActiveWorkbook.ActiveSheet.Name                  'recuperation du nom de la feuille
If ActiveCell.Column = 8 Or ActiveCell.Column = 7 Or ActiveCell.Column = 16 Or ActiveCell.Column = 9 Or ActiveCell.Column = 19 Then Exit Sub 'la macro n'est pas réalisée lorsque l'on clique dans les colonne G et H
If sortie_macro = 1 Then Exit Sub
 
'initialisation des variables
t = 0
aujourdhui = Date
lignetitre = 8
lastmaint = "P"
nextmaint = "Q"
typefreq = "O"
freq = "N"
i = lignetitre
freq1 = "jour"
freq2 = "mois"
freq3 = "an"
freq4 = "cycle"
 
message_alerte = 0
pre_alerte = -7                                            'message alerte s'affiche tant de jour(s) avant la date de la prochaine maintenance
 
 
'Do
 
'    i = i + 1
 
'Loop Until Cells(i, 2) = ""
'ReDim tabrep(i)
'nbreligne = i - lignetitre - 1                                  'nombre de ligne d'opération de maintenance
'premiereligne = lignetitre + 1
Application.ScreenUpdating = False
 Range(Range("A" & Rows.Count).End(xlUp), Cells(9, 1)).Select
 
 'on place dans un tableau les N° de lignes visibles
 Dim Tablo As New Collection, cellule As Range
 For Each cellule In Selection.SpecialCells(xlCellTypeVisible)
 On Error Resume Next
 Tablo.Add cellule.Row, CStr(cellule.Row)
 Next
 
 'initialisation du message d'erreur
 
 Msg = "Au moins une des opérations doit être envisagée dans les " & Abs(pre_alerte) & " prochains jours. Voulez-vous accedez à la premiere intervention ?" ' Définit le message.
 Style = vbYesNo + vbCritical + vbDefaultButton2 'Définit les boutons.
 Title = "Message d'ALERTE " 'Définit le titre.
ReDim tabrep(Tablo.Count)
 
 'on reprend les N° de lignes depuis la fin du tableau
 For N = Tablo.Count To 0 Step -1
 
 
'For N = premiereligne To i - 1
 
    celltypefreq = typefreq & N                                 'cellule à lire
    If Range(celltypefreq) = freq1 Then decalage = "d"          'determination du type de décalage determiné par le type de fréquence
    If Range(celltypefreq) = freq2 Then decalage = "m"         'determination du type de décalage determiné par le type de fréquence
    If Range(celltypefreq) = freq3 Then decalage = "yyyy"       'determination du type de décalage determiné par le type de fréquence
    If Range(celltypefreq) = freq4 Then                         'écrit "suivant fréquence" dans cellule "date prochaine maintenance"
             celldatnextmaint = nextmaint & N: Range(celldatnextmaint).Value = "suivant frequence": GoTo ligne1
    End If                                                      'à modifier suivant le type de fréquence
    'calcul de la prochaine date de maintenance
    cellfreq = freq & N                                         'cellule à lire
    datelastmaint = DateValue(Cells(N, lastmaint).Value)        'mise en forme de la date de la derniere maintenance
    nbrefreq = Range(cellfreq).Value                            'récuperation de la fréquence
    journextmaint = DateAdd(decalage, nbrefreq, datelastmaint)  'calcul du jour de la prochaine maintenance
 
    celldatnextmaint = nextmaint & N                            'cellule de destination
    Range(celldatnextmaint).Value = journextmaint               'écriture dans la cellule de destination
 
    date_alerte = DateAdd("d", pre_alerte, journextmaint)
    If aujourdhui >= date_alerte Then message_alerte = 1: tabrep(t) = N: t = t + 1    'test pour message d'alerte, on met message_alerte à 1 si au
                                                                                        'moins une date dépassée, on met le numéro de ligne dans le tableau
                                                                                        'tabrep à la position t
ligne1:
Next
 
Application.ScreenUpdating = True
If message_alerte = 1 Then Reponse = MsgBox(Msg, Style, Title) 'affichage du message
 
postabrep = 0                                                  'initilaisation de la position dans le tableau tabrep()
premierelignemauvaise = lastmaint & tabrep(postabrep)          'position de la premiere cellule rouge
If Reponse = vbYes Then sortie_macro = 1: affichage_messages
sortie_macro = 0
End Sub

04/05/2016, 15h57
Menhir

Un conseil d'abord : commence par enlever de ton code tout ce qui empêche de débuger correctement le code en phase de développement.
Entre autre :

Code:

Application.ScreenUpdating = False

et

Code:

On Error Resume Next

Essaye aussi de te passer de "Selection" et de placer la méthode directement sur le Range.
J'ai déjà eu le cas où des méthodes ou propriétés ne marchaient pas sur Selection alors qu'un Range était sélectionné.
04/05/2016, 16h12
joe.levrai

Bonjour,

il semblerait, au vu de ton code et du message d'erreur, que la plage représentée par Selection ne contient aucune ligne Visible !

vérifie la propriété .Address de cette plage et regarde si tu as au moins un élément visible
04/05/2016, 16h48
Menhir

Citation:

Envoyé par joe.levrai

vérifie la propriété .Address de cette plage et regarde si tu as au moins un élément visible

Ou la propriété .Count.

Mais même s'il n'y a pas de lignes visibles, ça ne devrait pas planter le code.
Ca se contentera de shunter la boucle For Each.
Pour que ça plante, il faudrait que Selection soit autre chose qu'un Range.

A moins ce ne soit Nothing.
Au lieu de faire un Select, mets ta plage dans une variable de type Range. Au moins on pourra voir ce qu'il y a dedans.

Non, si la sélection ne contient AUCUNE ligne visible, ça ne renverra pas 0 ou nothing, ça va planter

SpecialCells est une METHODE et pas une PROPRIETE.

essaye ça dans un fichier vierge
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 Sub toto() Rows(3).Hidden = False ' ici ça va afficher le nombre de colonnes du classeur With Rows(3).SpecialCells(xlCellTypeVisible) MsgBox .Count End With Rows(3).Hidden = True ' ici ça va planter With Rows(3).SpecialCells(xlCellTypeVisible) MsgBox .Count End With End Sub
C'est même moins permissif que FIND, puisqu'on peut pas tester si l'objet renvoyé est NOTHING quand il n'y a rien :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 Sub toto() Dim MaPlage As Range ' ici ça passe : on obtient FAUX Rows(3).Hidden = False Set MaPlage = Rows(3).SpecialCells(xlCellTypeVisible) MsgBox MaPlage Is Nothing ' ici ça plante Rows(3).Hidden = True Set MaPlage = Rows(3).SpecialCells(xlCellTypeVisible) MsgBox MaPlage Is Nothing End Sub
Le moins pire que j'utilise, c'est de gérer l'erreur, un exemple en passant par une variable (mais c'est pas nécessaire) :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 Sub toto() Dim MaPlage As Range Rows(3).Hidden = True On Error Resume Next Set MaPlage = Rows(3).SpecialCells(xlCellTypeVisible) On Error GoTo 0 If Not MaPlage Is Nothing Then MsgBox "Il y a des cellules visibles" Else MsgBox "Aucune cellule visible" End If End Sub
Si quelqu'un a plus joli, je suis preneur à 1000% :zoubi:

04/05/2016, 19h48
levothy

1 pièce(s) jointe(s)

j'ai modifié mon programme en prenant compte de vos conseils

cela va un peu mieux, mais ce n'est pas encore bon: normalement quant je lance la macro, le programme me prévient par un message 7 jours avant que j'ai une maintenance à effectuer sur la ligne concernée de même pour les interventions dépassées. Puis cela doit m'afficher une fenêtre description de l'intervention pour la ligne concernée.

dans mon nouveau programme, cela m'affiche le message, puis ensuite une série de date (la même) s'inscrit dans la colonne q (équivalente au nombre de mes lignes concernées par l'alerte, de q1 à q8 dans cet exemple), puis la fenêtre description s'affiche pour les nouvelles lignes en colonne q.
04/05/2016, 19h52
levothy

1 pièce(s) jointe(s)

voici ce que devrai faire le programme pour bien me faire comprendre,

mais celui ci n'est pas exploitable pour un nombre important de lignes :(
06/05/2016, 08h58
Menhir

Pour la seconde fois : http://www.developpez.net/forums/d84...s-discussions/