Filtrer a la place de masquer
Bonjour , et bonne fête a tous.
voila j'ai une macro qui me permet de masquer des lignes selon la case cocher
et au lieux de masquer j'aimerais filtrer je le fais deja dans une autre macro mais je suis un peu perdu
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'Personnel
Application.ScreenUpdating = False
If Not Intersect(Target, Range("I6:I65")) Is Nothing Then
If Cells(Target.Row, 9) = "X" Then
Cells(Target.Row, 9) = ""
For Each f In Sheets(Array("HJanvier", "Janvier", "BJanvier"))
If f.Range("A6") = "Jours" And f.Range("A8") = Range("X26") Then
For i = 9 To 65
If f.Range("A" & i) = Cells(Target.Row, 8).Value Then
f.Rows(i & ":" & i).EntireRow.Hidden = False
End If
Next i
End If
Next f
Else
Cells(Target.Row, 9) = "X"
For Each f In Sheets(Array("HJanvier", "Janvier", "BJanvier"))
If f.Range("A6") = "Jours" And f.Range("A8") = Range("X26") Then
For i = 9 To 65
If f.Range("A" & i) = Cells(Target.Row, 8).Value Then
f.Rows(i & ":" & i).EntireRow.Hidden = True
End If
Next i
End If
Next f
End If
End If
l"autre macro qui filtre
Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
Dim WS As Worksheet
Dim wss As Worksheet
For Each WS In Sheets(Array("HJanvier", "HFevrier", "HMars", "HAvril", "HMai", "HJuin", _
"HJuillet", "HAout", "HSeptembre", "HOctobre", "HNovembre", "HDecembre", _
"BJanvier", "BFevrier", "BMars", "BAvril", "BMai", "BJuin", _
"BJuillet", "BAout", "BSeptembre", "BOctobre", "BNovembre", "BDecembre", _
"Bilan"))
If Not Intersect(Target, Range("H5:H69")) Is Nothing Then
WS.Unprotect "azerty"
WS.Range("$A$8:$A$67").AutoFilter Field:=1, Criteria1:="<>", Visibledropdown:=False
WS.Protect ("azerty"), DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingCells:=True, AllowFormattingColumns:=True, AllowFormattingRows:=True, AllowFiltering:=True
End If
Next WS
For Each wss In Sheets(Array("Janvier", "Fevrier", "Mars", "Avril", "Mai", "Juin", _
"Juillet", "Aout", "Septembre", "Octobre", "Novembre", "Decembre"))
If Not Intersect(Target, Range("H5:H69")) Is Nothing Then
wss.Unprotect "azerty"
wss.Range("$A$8:$A$67").AutoFilter Field:=1, Criteria1:="<>", Visibledropdown:=False
wss.Protect ("azerty"), DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingCells:=True, AllowFormattingColumns:=True, AllowFormattingRows:=True, AllowFiltering:=True
End If
Next wss
personnel
Application.ScreenUpdating = True
End Sub
merci d'avance
Bonjour Keran Latos, bonjour le forum,
je n'ai pas regardé ton code... Mais Filtrer c'est Masquer. C'est exactement la même chose !... Ou plutôt, c'est exactement son contraire... Que tu masques toutes les lignes qui contiennent "X" en colonne C revient au même que de filtrer toute les lignes ne contenant pas "X" en colonne C. C'est une question d'écriture et, sur de très grands tableaux, de rapidité d'exécution. mais si tu as un code qui fonctionne je ne vois pas trop l'intérêt d'en changer...
bonjour ,
merci de la réponse
je voulais changer pour une question de rapidité mon tableur est très grand effectivement et de plus je voulais que ma fonction avec les filtre puisse exécuter celle avec les masque aussi car elle sont liée.
merci
(je voulais fusionner les deux formule en une avec des filtre )
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'Personnel selection
Application.ScreenUpdating = False
If Not Intersect(Target, Range("I6:I65")) Is Nothing Then
If Cells(Target.Row, 9) = "X" Then
Cells(Target.Row, 9) = ""
For Each f In Sheets(Array("HJanvier", "Janvier", "BJanvier"))
If f.Range("A6") = "Jours" And f.Range("A8") = Range("X26") Then
For i = 9 To 65
If f.Range("A" & i) = Cells(Target.Row, 8).Value Then
f.Rows(i & ":" & i).EntireRow.Hidden = False
End If
Next i
End If
Next f
Else
Cells(Target.Row, 9) = "X"
For Each f In Sheets(Array("HJanvier", "Janvier", "BJanvier"))
If f.Range("A6") = "Jours" And f.Range("A8") = Range("X26") Then
For i = 9 To 65
If f.Range("A" & i) = Cells(Target.Row, 8).Value Then
f.Rows(i & ":" & i).EntireRow.Hidden = True
End If
Next i
End If
Next f
End If
End If
If Not Intersect(Target, Range("J6:J65")) Is Nothing Then
If Cells(Target.Row, 10) = "X" Then
Cells(Target.Row, 10) = ""
For Each f In Sheets(Array("HFevrier", "Fevrier", "BFevrier"))
If f.Range("A6") = "Jours" And f.Range("A8") = Range("X26") Then
For i = 9 To 65
If f.Range("A" & i) = Cells(Target.Row, 8).Value Then
f.Rows(i & ":" & i).EntireRow.Hidden = False
End If
Next i
End If
Next f
Else
Cells(Target.Row, 10) = "X"
For Each f In Sheets(Array("HFevrier", "Fevrier", "BFevrier"))
If f.Range("A6") = "Jours" And f.Range("A8") = Range("X26") Then
For i = 9 To 65
If f.Range("A" & i) = Cells(Target.Row, 8).Value Then
f.Rows(i & ":" & i).EntireRow.Hidden = True
End If
Next i
End If
Next f
End If
End If
If Not Intersect(Target, Range("K6:K65")) Is Nothing Then
If Cells(Target.Row, 11) = "X" Then
Cells(Target.Row, 11) = ""
For Each f In Sheets(Array("HMars", "Mars", "BMars", "Bilan"))
If f.Range("A6") = "Jours" And f.Range("A8") = Range("x26") Then
For i = 9 To 65
If f.Range("A" & i) = Cells(Target.Row, 8).Value Then
f.Rows(i & ":" & i).EntireRow.Hidden = False
End If
Next i
End If
Next f
Else
Cells(Target.Row, 11) = "X"
For Each f In Sheets(Array("HMars", "Mars", "BMars"))
If f.Range("A6") = "Jours" And f.Range("A8") = Range("x26") Then
For i = 9 To 65
If f.Range("A" & i) = Cells(Target.Row, 8).Value Then
f.Rows(i & ":" & i).EntireRow.Hidden = True
End If
Next i
End If
Next f
End If
End If
If Not Intersect(Target, Range("L6:L65")) Is Nothing Then
If Cells(Target.Row, 12) = "X" Then
Cells(Target.Row, 12) = ""
For Each f In Sheets(Array("HAvril", "Avril", "BAvril"))
If f.Range("A6") = "Jours" And f.Range("A8") = Range("x26") Then
For i = 9 To 65
If f.Range("A" & i) = Cells(Target.Row, 8).Value Then
f.Rows(i & ":" & i).EntireRow.Hidden = False
End If
Next i
End If
Next f
Else
Cells(Target.Row, 12) = "X"
For Each f In Sheets(Array("HAvril", "Avril", "BAvril"))
If f.Range("A6") = "Jours" And f.Range("A8") = Range("x26") Then
For i = 9 To 65
If f.Range("A" & i) = Cells(Target.Row, 8).Value Then
f.Rows(i & ":" & i).EntireRow.Hidden = True
End If
Next i
End If
Next f
End If
End If
If Not Intersect(Target, Range("M6:M65")) Is Nothing Then
If Cells(Target.Row, 13) = "X" Then
Cells(Target.Row, 13) = ""
For Each f In Sheets(Array("HMai", "Mai", "BMai"))
If f.Range("A6") = "Jours" And f.Range("A8") = Range("x26") Then
For i = 9 To 65
If f.Range("A" & i) = Cells(Target.Row, 8).Value Then
f.Rows(i & ":" & i).EntireRow.Hidden = False
End If
Next i
End If
Next f
Else
Cells(Target.Row, 13) = "X"
For Each f In Sheets(Array("HMai", "Mai", "BMai"))
If f.Range("A6") = "Jours" And f.Range("A8") = Range("x26") Then
For i = 9 To 65
If f.Range("A" & i) = Cells(Target.Row, 8).Value Then
f.Rows(i & ":" & i).EntireRow.Hidden = True
End If
Next i
End If
Next f
End If
End If
If Not Intersect(Target, Range("N6:N65")) Is Nothing Then
If Cells(Target.Row, 14) = "X" Then
Cells(Target.Row, 14) = ""
For Each f In Sheets(Array("HJuin", "Juin", "BJuin"))
If f.Range("A6") = "Jours" And f.Range("A8") = Range("x26") Then
For i = 9 To 65
If f.Range("A" & i) = Cells(Target.Row, 8).Value Then
f.Rows(i & ":" & i).EntireRow.Hidden = False
End If
Next i
End If
Next f
Else
Cells(Target.Row, 14) = "X"
For Each f In Sheets(Array("HJuin", "Juin", "BJuin"))
If f.Range("A6") = "Jours" And f.Range("A8") = Range("x26") Then
For i = 9 To 65
If f.Range("A" & i) = Cells(Target.Row, 8).Value Then
f.Rows(i & ":" & i).EntireRow.Hidden = True
End If
Next i
End If
Next f
End If
End If
If Not Intersect(Target, Range("O6:O65")) Is Nothing Then
If Cells(Target.Row, 15) = "X" Then
Cells(Target.Row, 15) = ""
For Each f In Sheets(Array("HJuillet", "Juillet", "BJuillet"))
If f.Range("A6") = "Jours" And f.Range("A8") = Range("x26") Then
For i = 9 To 65
If f.Range("A" & i) = Cells(Target.Row, 8).Value Then
f.Rows(i & ":" & i).EntireRow.Hidden = False
End If
Next i
End If
Next f
Else
Cells(Target.Row, 15) = "X"
For Each f In Sheets(Array("HJuillet", "Juillet", "BJuillet"))
If f.Range("A6") = "Jours" And f.Range("A8") = Range("x26") Then
For i = 9 To 65
If f.Range("A" & i) = Cells(Target.Row, 8).Value Then
f.Rows(i & ":" & i).EntireRow.Hidden = True
End If
Next i
End If
Next f
End If
End If
If Not Intersect(Target, Range("P6:P65")) Is Nothing Then
If Cells(Target.Row, 16) = "X" Then
Cells(Target.Row, 16) = ""
For Each f In Sheets(Array("HAout", "Aout", "BAout"))
If f.Range("A6") = "Jours" And f.Range("A8") = Range("x26") Then
For i = 9 To 65
If f.Range("A" & i) = Cells(Target.Row, 8).Value Then
f.Rows(i & ":" & i).EntireRow.Hidden = False
End If
Next i
End If
Next f
Else
Cells(Target.Row, 16) = "X"
For Each f In Sheets(Array("HAout", "Aout", "BAout"))
If f.Range("A6") = "Jours" And f.Range("A8") = Range("x26") Then
For i = 9 To 65
If f.Range("A" & i) = Cells(Target.Row, 8).Value Then
f.Rows(i & ":" & i).EntireRow.Hidden = True
End If
Next i
End If
Next f
End If
End If
Application.ScreenUpdating = True
End Sub
Re,
Pas vraiment compris ce que tu voulais faire mais il me semble que ton dernier code pourrait se résumer à :
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim OS As Variant 'déclare le tableau des variables OS
Dim F As Worksheet 'déclare la variable F
Dim I As Byte 'déclare la variable I (Incrément)
Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
'si la cellule double-cliquée se trouve dans une ligne inférieure à 6 ou supérieure à 65, sort de la procédure
If Target.Row < 6 Or Target.Row > 65 Then Exit Sub
'si la cellule double-cliquée se trouve dans une colonne inférieure à 9 ou supérieure à 16, sort de la procédure
If Target.Column < 9 Or Target.Column > 16 Then Exit Sub
Cancel = True 'annule le mode [Édition] lié au double-clic
Select Case Target.Column 'agit en fonction de la colonne double-cliquée
Case 9 'cas 9 (=> colonne I)
Set OS = Sheets(Array("HJanvier", "Janvier", "BJanvier")) 'définit le tableau des onglets OS
Case 10 'cas 10 (=> colonne J)
Set OS = Sheets(Array("HFevrier", "Fevrier", "BFevrier")) 'définit le tableau des onglets OS
Case 11 'cas 11 (=> colonne K)
Set OS = Sheets(Array("HMars", "Mars", "BMars")) 'définit le tableau des onglets OS
Case 12 'cas 12 (=> colonne L)
Set OS = Sheets(Array("HAvril", "Avril", "BAvril")) 'définit le tableau des onglets OS
Case 13 'cas 13 (=> colonne M)
Set OS = Sheets(Array("HMai", "Mai", "BMai")) 'définit le tableau des onglets OS
Case 14 'cas 14 (=> colonne N)
Set OS = Sheets(Array("HJuin", "Juin", "BJuin")) 'définit le tableau des onglets OS
Case 15 'cas 15 (=> colonne O)
Set OS = Sheets(Array("HJuillet", "Juillet", "BJuillet")) 'définit le tableau des onglets OS
Case 16 'cas 16 (=> colonne P)
Set OS = Sheets(Array("HAout", "Aout", "BAout")) 'définit le tableau des onglets OS
End Select 'fin de l'action en fonction de la colonne double-cliquée
Target.Value = IIf(Target.Value = "X", "", "X") 'de'finit la valeur de la cellule double-cliquée (X si vide, vide si X)
For Each F In OS 'boucle sur tous les onglets du tableau des onglets OS
If F.Range("A6") = "Jours" And F.Range("A8") = Range("X26") Then 'condition 1
For I = 9 To 65 'boucle sur les ligne 9 à 65
'si la condition est respectée masque la feuille si la cellule vaut X, sinon la ligne reste affichée
If F.Range("A" & I) = Cells(Target.Row, 8).Value Then F.Rows(I).Hidden = Target.Value = "X"
Next I 'prochaine ligne de la boucle
End If 'fin de la condition
Next F 'prochain onglet de la boucle
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
End Sub
Avec l'ajout peut-être d'un code pour l'onglet Bilan que j'ai vu traîner quelque part...
deja juste merci je vais essayer de tous comprendre
Desoler pour le double post j'ai pas trouver le bouton editer ^^"
Je voulais savoir si je fais veux que ma vba
Private Sub Worksheet_Change(ByVal Target As Range)
Dim OS As Variant 'déclare le tableau des variables OS
Dim F As Worksheet 'déclare la variable F
Dim I As Byte 'déclare la variable I (Incrément)
Dim WS As Worksheet
Dim wss As Worksheet
Application.ScreenUpdating = False
For Each WS In Sheets(Array("HJanvier", "HFevrier", "HMars", "HAvril", "HMai", "HJuin", _
"HJuillet", "HAout", "HSeptembre", "HOctobre", "HNovembre", "HDecembre", _
"BJanvier", "BFevrier", "BMars", "BAvril", "BMai", "BJuin", _
"BJuillet", "BAout", "BSeptembre", "BOctobre", "BNovembre", "BDecembre", _
"Bilan"))
If Not Intersect(Target, Range("H5:H69")) Is Nothing Then
WS.Unprotect "azerty"
WS.Range("$A$8:$A$67").AutoFilter Field:=1, Criteria1:="<>", Visibledropdown:=False
WS.Protect ("azerty"), DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingCells:=True, AllowFormattingColumns:=True, AllowFormattingRows:=True, AllowFiltering:=True
End If
Next WS
For Each wss In Sheets(Array("Janvier", "Fevrier", "Mars", "Avril", "Mai", "Juin", _
"Juillet", "Aout", "Septembre", "Octobre", "Novembre", "Decembre"))
If Not Intersect(Target, Range("H5:H69")) Is Nothing Then
wss.Unprotect "azerty"
wss.Range("$A$8:$A$67").AutoFilter Field:=1, Criteria1:="<>", Visibledropdown:=False
wss.Protect ("azerty"), DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingCells:=True, AllowFormattingColumns:=True, AllowFormattingRows:=True, AllowFiltering:=True
End If
Next wss
Application.ScreenUpdating = True
End Sub
puisse faire appel a cette vba apres c'est possible ?
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim OS As Variant 'déclare le tableau des variables OS
Dim F As Worksheet 'déclare la variable F
Dim I As Byte 'déclare la variable I (Incrément)
Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
'si la cellule double-cliquée se trouve dans une ligne inférieure à 6 ou supérieure à 65, sort de la procédure
If Target.Row < 6 Or Target.Row > 65 Then Exit Sub
'si la cellule double-cliquée se trouve dans une colonne inférieure à 9 ou supérieure à 16, sort de la procédure
If Target.Column < 9 Or Target.Column > 19 Then Exit Sub
Cancel = True 'annule le mode [Édition] lié au double-clic
Select Case Target.Column 'agit en fonction de la colonne double-cliquée
Case 9 'cas 9 (=> colonne I)
Set OS = Sheets(Array("HJanvier", "Janvier", "BJanvier")) 'définit le tableau des onglets OS
Case 10 'cas 10 (=> colonne J)
Set OS = Sheets(Array("HFevrier", "Fevrier", "BFevrier")) 'définit le tableau des onglets OS
Case 11 'cas 11 (=> colonne K)
Set OS = Sheets(Array("HMars", "Mars", "BMars")) 'définit le tableau des onglets OS
Case 12 'cas 12 (=> colonne L)
Set OS = Sheets(Array("HAvril", "Avril", "BAvril")) 'définit le tableau des onglets OS
Case 13 'cas 13 (=> colonne M)
Set OS = Sheets(Array("HMai", "Mai", "BMai")) 'définit le tableau des onglets OS
Case 14 'cas 14 (=> colonne N)
Set OS = Sheets(Array("HJuin", "Juin", "BJuin")) 'définit le tableau des onglets OS
Case 15 'cas 15 (=> colonne O)
Set OS = Sheets(Array("HJuillet", "Juillet", "BJuillet")) 'définit le tableau des onglets OS
Case 16 'cas 16 (=> colonne P)
Set OS = Sheets(Array("HAout", "Aout", "BAout")) 'définit le tableau des onglets OS
Case 16 'cas 16 (=> colonne P)
Set OS = Sheets(Array("HSetempbre", "Septembre", "BSeptembre")) 'définit le tableau des onglets OS
Case 17 'cas 17 (=> colonne Q)
Set OS = Sheets(Array("HOctobre", "Octobre", "BOctobre")) 'définit le tableau des onglets OS
Case 18 'cas 18 (=> colonne R)
Set OS = Sheets(Array("HNovembre", "Novembre", "BNovembre")) 'définit le tableau des onglets OS
Case 19 'cas 19 (=> colonne S)
Set OS = Sheets(Array("HDecembre", "Decembre", "BDecembre")) 'définit le tableau des onglets OS
End Select 'fin de l'action en fonction de la colonne double-cliquée
Target.Value = IIf(Target.Value = "X", "", "X") 'de'finit la valeur de la cellule double-cliquée (X si vide, vide si X)
For Each F In OS 'boucle sur tous les onglets du tableau des onglets OS
If F.Range("A6") = "Jours" And F.Range("A8") = Range("X26") Then 'condition 1
For I = 9 To 65 'boucle sur les ligne 9 à 65
'si la condition est respectée masque la feuille si la cellule vaut X, sinon la ligne reste affichée
If F.Range("A" & I) = Cells(Target.Row, 8).Value Then F.Rows(I).Hidden = Target.Value = "X"
Next I 'prochaine ligne de la boucle
End If 'fin de la condition
Next F 'prochain onglet de la boucle
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
End Sub