Autres (RESOLU)Afficher les lignes qui contient 1

[chaelie2015]

Bonsoir
Je souhaite via VBA (bouton) d'afficher toutes les lignes (a partir de la ligne 6) de la colonne Q qui contient la valeur 1 par un bouton.
a+

 

[chaelie2015]

Bonsoir chaelie2015, Phil69970, mapomme,

Sub Filtrer_les_1()
Application.ScreenUpdating = False
On Error Resume Next 'si aucune SpecialCell
If FilterMode Then ShowAllData 'si la feuille est filtrée
With Range("Q6", Range("Q" & Rows.Count).End(xlUp))
    .Replace 1, "#N/A", xlWhole
    .EntireRow.Hidden = True 'masque tout
    .SpecialCells(xlCellTypeConstants, 16).EntireRow.Hidden = False 'affiche
    .Replace "#N/A", 1
End With
End Sub

Sub RAZ()
Rows.Hidden = False 'affiche tout
End Sub

Bonne nuit.

Bonjour Job
Dans le cas ou j'ai des cellules fusionnées j'ai un petit souci?
ci joint l'exemple
et je souhaite l'appliquer pour une autre colonne
a+

 

[mapomme]

Re,

@chaelie2015
Dans le cas ou j'ai des cellules fusionnées

 

[job75]

Bonjour chaelie2015, mapomme,

Sub Filtrer_les_1()
Application.ScreenUpdating = False
On Error Resume Next 'si aucune SpecialCell
If FilterMode Then ShowAllData 'si la feuille est filtrée
With Range("Q6:Q" & Cells.SpecialCells(xlCellTypeLastCell).Row)
    .Replace 1, "#N/A", xlWhole
    .EntireRow.Hidden = True 'masque tout
    .SpecialCells(xlCellTypeConstants, 16).EntireRow.Hidden = False 'affiche
    .Replace "#N/A", 1
End With
End Sub

Sub RAZ()
Rows.Hidden = False 'affiche tout
End Sub

Sub FiltrerB_les_1()
Application.ScreenUpdating = False
On Error Resume Next 'si aucune SpecialCell
If FilterMode Then ShowAllData 'si la feuille est filtrée
With Range("T6:T" & Cells.SpecialCells(xlCellTypeLastCell).Row)
    .Replace 1, "#N/A", xlWhole
    .EntireRow.Hidden = True 'masque tout
    .SpecialCells(xlCellTypeConstants, 16).EntireRow.Hidden = False 'affiche
    .Replace "#N/A", 1
End With
End Sub

Pas regardé la solution de mapomme.

A+

 

[chaelie2015]

Bonjour mapomme
Bonjour JOB
Merci infiniment c'est extra.
a+

 

[mapomme]

Re,
version v3 plus rapide que la v2.

 

[chaelie2015]

RE JOB , MAPOMME
mapomme merci encore pour les solutions
je souhaite encore conditionner le code par le filtre de l'Excel selon le filtre de la colonne K.
Merci par avance.

 

[Eric C]

Bonjour le forum
Bonjour chaelie, Phil, mapomme & job

Waouh.... Waouh & encore Waouhhhhhh -- Il semblera

 

[Eric C]

Bonjour le forum
Bonjour chaelie, Phil, mapomme & job
Je reprends, une touche "enter" trop rapide
Waouh.... Waouh & encore Waouhhhhhh -- Page 1 : --------------------------------------------------------Notre ami job75 (que je salue au passage), a obtenu sur ce sujet, le césar. Il me semble, à ce stade (Page1) mais cela n'engage que moi, que nos amis nominés mapomme et Phil (que je salue tout deux également), étaient également bien engagés avec une petite préférence pour Phil qui s'est bien investi dès le départ. Hormis un codage peut être plus synthétisé et l'ajout du bouton "Raz" de job, il semblerait que tout notre beau monde soit parvenu à une finalité identique. Pourtant, une chose m'interpelle : Page 1 : Job a eu le césar avec un pouce, mapomme un pouce et Phil : Nada ????
C'était mon coup de g... du jour ... Ca fait du bien..
@+ Eric c

 

[job75]

je souhaite encore conditionner le code par le filtre de l'Excel selon le filtre de la colonne K.

Sub Filtrer_les_1()
Dim P As Range
On Error Resume Next 'si aucune SpecialCell
RAZ
With Range("Q6:Q" & Cells.SpecialCells(xlCellTypeLastCell).Row)
    Set P = .SpecialCells(xlCellTypeVisible)
    .Replace 1, "#N/A", xlWhole
    .EntireRow.Hidden = True 'masque tout
    Intersect(P, .SpecialCells(xlCellTypeConstants, 16)).EntireRow.Hidden = False 'affiche
    .Replace "#N/A", 1
End With
End Sub

Sub RAZ()
Application.ScreenUpdating = False
If FilterMode Then ShowAllData 'si la feuille est filtrée
With Range("K6:K" & Cells.SpecialCells(xlCellTypeLastCell).Row)
    .Rows.Hidden = False 'affiche tout
    .AutoFilter 1, "BEL" 'critère à adapter
End With
End Sub

Sub FiltrerB_les_1()
Dim P As Range
On Error Resume Next 'si aucune SpecialCell
RAZ
With Range("T6:T" & Cells.SpecialCells(xlCellTypeLastCell).Row).SpecialCells(xlCellTypeVisible)
    Set P = .SpecialCells(xlCellTypeVisible)
    .Replace 1, "#N/A", xlWhole
    .EntireRow.Hidden = True 'masque tout
    Intersect(P, .SpecialCells(xlCellTypeConstants, 16)).EntireRow.Hidden = False 'affiche
    .Replace "#N/A", 1
End With
End Sub

Salut Eric C.

Edit : des Application.ScreenUpdating = False inutiles.

 

[chaelie2015]

Sub Filtrer_les_1()
Dim P As Range
Application.ScreenUpdating = False
On Error Resume Next 'si aucune SpecialCell
RAZ
With Range("Q6:Q" & Cells.SpecialCells(xlCellTypeLastCell).Row)
    Set P = .SpecialCells(xlCellTypeVisible)
    .Replace 1, "#N/A", xlWhole
    .EntireRow.Hidden = True 'masque tout
    Intersect(P, .SpecialCells(xlCellTypeConstants, 16)).EntireRow.Hidden = False 'affiche
    .Replace "#N/A", 1
End With
End Sub

Sub RAZ()
Application.ScreenUpdating = False
If FilterMode Then ShowAllData 'si la feuille est filtrée
With Range("K6:K" & Cells.SpecialCells(xlCellTypeLastCell).Row)
    .Rows.Hidden = False 'affiche tout
    .AutoFilter 1, "BEL" 'critère à adapter
End With
End Sub

Sub FiltrerB_les_1()
Dim P As Range
Application.ScreenUpdating = False
On Error Resume Next 'si aucune SpecialCell
RAZ
With Range("T6:T" & Cells.SpecialCells(xlCellTypeLastCell).Row).SpecialCells(xlCellTypeVisible)
    Set P = .SpecialCells(xlCellTypeVisible)
    .Replace 1, "#N/A", xlWhole
    .EntireRow.Hidden = True 'masque tout
    Intersect(P, .SpecialCells(xlCellTypeConstants, 16)).EntireRow.Hidden = False 'affiche
    .Replace "#N/A", 1
End With
End Sub

Salut Eric C.

Re
Merci job
pourquoi que "Bel" et les autres ?
"AutoFilter 1, "BEL" '
a+

 

[job75]

Il faut se donner a priori le critère de filtrage en colonne K.

Autrement ce serait une usine à gaz.

 

[chaelie2015]

Il faut se donner a priori le critère de filtrage en colonne K.

Autrement ce serait une usine à gaz.

Bjr JOB ,forum
oui tu as raison, malheureusement je l'ai constaté lors de la construction du mon fichier. sorry
a+