XL 2016 filtrer des lignes en vba

halecs93

XLDnaute Impliqué
Bonjour à tout le monde. Et encore un grand merci à toutes les personnes qui m'ont permis de bien avancer.

Je poursuis donc mon classeur "planning" et je bute sur une chose. Il s'agit de déclencher les filtres afin de ne faire apparaître, par exemple, que les lundis. J'ai bricolé un petit quelque chose qui semble fonctionner. En cliquant sur un des jours de la semaine, ça filtre bien (même si ce n'est pas super joli de voir apparaitre le bouton de filtrage).

Mais si je veux obtenir, toujours par exemple, uniquement les lundis et sans les lignes "remplaçant".... je bloque.

Pas certain que ça puisse se faire, mais je poste quand même ;)

Encore une fois, un grand merci
1695546469466.png
 

Pièces jointes

  • halecs93- PLANNING- exceldownloads.xlsm
    599.9 KB · Affichages: 12
Solution
Re

En partant de ton dernier fichier
1) J'ai renommer les images avec le nom des jours
2) Affecter à ces images la même macro (sur le même principe que précédemment)
Code:
Sub macro_Bouton()
Jour = UCase(ActiveSheet.Shapes(Application.Caller).Name)
Filtrer Jour
End Sub
Private Sub Filtrer(ByVal Jour As String)
Dim ws As Worksheet
    Set ws = ActiveSheet
    ' Déproteger la feuille
    If ws.ProtectContents Then
        ws.Unprotect
    End If
    ' Protéger la feuille en autorisant la sélection des cellules verrouillées
    ws.Protect UserInterfaceOnly:=True, AllowFiltering:=True
    ' Appliquer le filtre
    ws.Range("A6:A500").AutoFilter Field:=1, Criteria1:=Jour, VisibleDropDown:=0
    ' Mettre à jour la cellule BE1 avec le nom de la...

laurent950

XLDnaute Barbatruc
Bonjour @halecs93

Filtre Colonne A à D dernière ligne non vide de la colonne A + 10 Lignes :
"lundi" en colonne A et "remplaçant" en colonne D
En cliquant sur un ce jours de la semaine "lundi"
Déclenche le filtre afin faire apparaître que les "lundi" mais ne pas faire apparaître "remplaçant"
Ne pas voir apparaitre le bouton de filtrage (Colonne A à D)

VB:
Sub FiltrerLundi()
Application.ScreenUpdating = True 
Dim ws As Worksheet
    Set ws = ActiveSheet
    ' Déprotéger la feuille active
        ws.Unprotect
    ' Désactiver tous les filtres pour afficher toutes les données
        ws.AutoFilterMode = False
    ' Activer le filtre à partir de la cellule A5:D5 pour "lundi" et "remplaçant"
    Dim lastRow As Long
        lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).row + 10
    ' Filtre la colonne A pour "lundi"
        ws.Range("A6:D" & lastRow).AutoFilter Field:=1, Criteria1:="=lundi", VisibleDropDown:=False
    ' Filtre la colonne D pour différent de "remplaçant"
        ws.Range("A6:D" & lastRow).AutoFilter Field:=4, Criteria1:="<>remplaçant", Operator:=xlAnd, VisibleDropDown:=False
    ' Masque la flèche déroulante
        ws.Range("A6:D" & lastRow).AutoFilter Field:=2, VisibleDropDown:=False
        ws.Range("A6:D" & lastRow).AutoFilter Field:=3, VisibleDropDown:=False
    ' Protéger la feuille active
    ws.Protect
Application.ScreenUpdating = False
End Sub
 
Dernière édition:

halecs93

XLDnaute Impliqué
Bonjour @halecs93

Filtre Colonne A à D dernière ligne non vide de la colonne A + 10 Lignes :
"lundi" en colonne A et "remplaçant" en colonne D
En cliquant sur un ce jours de la semaine "lundi"
Déclenche le filtre afin faire apparaître que les "lundi" mais ne pas faire "remplaçant"
Ne pas voir apparaitre le bouton de filtrage (Colonne A à D)

si résolu passer ce poste à résolu, puis une autre discussion pour la suite.

VB:
Sub FiltrerLundi()
Application.ScreenUpdating = True   
Dim ws As Worksheet
    On Error Resume Next ' Ignorer les erreurs si la feuille n'existe pas
    Set ws = ActiveSheet
    On Error GoTo 0 ' Réactiver les erreurs
    If ws Is Nothing Then
        MsgBox "Aucune feuille active n'est sélectionnée.", vbExclamation
        Exit Sub
    End If
    ' Déprotéger la feuille active
        ws.Unprotect
    ' Désactiver tous les filtres pour afficher toutes les données
        ws.AutoFilterMode = False
    ' Activer le filtre à partir de la cellule A5:D5 pour "lundi" et "remplaçant"
    Dim lastRow As Long
        lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).row + 10
    ' Filtre la colonne A pour "lundi"
        ws.Range("A6:D" & lastRow).AutoFilter Field:=1, Criteria1:="=lundi", VisibleDropDown:=False
    ' Filtre la colonne D pour différent de "remplaçant"
        ws.Range("A6:D" & lastRow).AutoFilter Field:=4, Criteria1:="<>remplaçant", Operator:=xlAnd, VisibleDropDown:=False
    ' Masque la flèche déroulante
        ws.Range("A6:D" & lastRow).AutoFilter Field:=2, VisibleDropDown:=False
        ws.Range("A6:D" & lastRow).AutoFilter Field:=3, VisibleDropDown:=False
    ' Protéger la feuille active
    ws.Protect
Application.ScreenUpdating = False
End Sub
Merci.... pour le moment, je tentais cette approche :

Sub FiltrerLundi()
Dim ws As Worksheet
Set ws = ActiveSheet

' Déproteger la feuille
If ws.ProtectContents Then
ws.Unprotect
End If

' Appliquer le filtre
ws.Range("A6:D500").AutoFilter _
Field:=1, _
Criteria1:="LUNDI", _
VisibleDropDown:=False

' Protéger la feuille
ws.Protect
End Sub
 

Staple1600

XLDnaute Barbatruc
Bonjour le fil

Avec le filtre avancé
(si j'ai bien compris la question)
VB:
Sub Avec_Filtre_Avancé()
ActiveSheet.Unprotect
Application.ScreenUpdating = False
Range("BV4").FormulaR1C1 = "=AND(RC[-73]=""LUNDI"",RC[-70]<>""remplaçant"")"
Range("A3:D497").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range("BV3:BV4"), Unique:=False
End Sub

NB: Pour infos
Le classeur rame chez moi et plante plus ou moins Excel

Suggestion en passant
On pourrait n'avoir qu'un seul bouton pour filtrer les jours
(avec son caption qui change selon le jour indiqué dans le filtre
 

halecs93

XLDnaute Impliqué
Bonjour le fil

Avec le filtre avancé
(si j'ai bien compris la question)
VB:
Sub Avec_Filtre_Avancé()
ActiveSheet.Unprotect
Application.ScreenUpdating = False
Range("BV4").FormulaR1C1 = "=AND(RC[-73]=""LUNDI"",RC[-70]<>""remplaçant"")"
Range("A3:D497").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range("BV3:BV4"), Unique:=False
End Sub

NB: Pour infos
Le classeur rame chez moi et plante plus ou moins Excel

Suggestion en passant
On pourrait n'avoir qu'un seul bouton pour filtrer les jours
(avec son caption qui change selon le jour indiqué dans le filtre
Bonjour et merci. Non, en fait, si j'applique un filtre sur les jours (ça semble fonctionner correctement maintenant), mais que je veux appliquer par la suite un autre filtre, là ça ne fonctionne plus. Exemple : je filtre sur les lundis, mais je ne veux pas voir apparaître les lignes "remplaçant". En gros je souhaitais ajouter une commande pour les faire apparaître ou pas
 

Staple1600

XLDnaute Barbatruc
Re

je n'ai que répondre à ce qui est écrit dans ton message, non ?
Mais si je veux obtenir, toujours par exemple, uniquement les lundis et sans les lignes "remplaçant".... je bloque.

Avec cette version, tu peux choisir je jour
Ici MARDI
Code:
Sub mMARDI()
'ActiveSheet.ShowAllData
FILTRAGE "MARDI"
End Sub
Private Sub FILTRAGE(ByVal Jour As String)
ActiveSheet.Unprotect
Application.ScreenUpdating = False
Range("BV4").Formula2 = "=AND(A4=" & Chr(34) & Jour & Chr(34) & ",D4<>""remplaçant"")"
Range("A3:D497").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range("BV3:BV4"), Unique:=False
End Sub
 

laurent950

XLDnaute Barbatruc
Re @halecs93 Bonjour@Staple1600

Comment tu peux faire une erreur ici @halecs93, j'ai la réponse mais j'aimerais que tu m'expliques s'il te plait avant de poursuivre ?

On Error Resume Next ' Ignorer les erreurs si la feuille n'existe pas
Set ws = ActiveSheet
On Error GoTo 0 ' Réactiver les erreurs
If ws Is Nothing Then
MsgBox "Aucune feuille active n'est sélectionnée.", vbExclamation
Exit Sub
End If
 

Discussions similaires

Statistiques des forums

Discussions
313 297
Messages
2 096 928
Membres
106 789
dernier inscrit
FrancoisVLD