Opérations sur un range

[ThierryP]

Bonjour Denis et le forum,

Est-il possible de masquer des lignes selon la valeur d'une cellule sans boucler sur la plage ?

L'idée est quelque chose du genre (mais qui ne fonctionne pas bien sûr !!!) :
Sub test()
With Feuil1
With .Range("A1:A8")
If .Value = "x" Then .EntireRow.Hidden = True
End With
End With
End Sub

Merci d'avance à tout généreux contributeur !!
Bon week-end,

ThierryP

[MichD]

Le 22/04/22 à 10:04, ThierryP a écrit :

Bonjour,

Ce que tu demandes est impossible quant à ta manière de procéder. Sauf
un cas d'exception, une colonne contenant qu'UNE valeur numérique dans
différentes cellules et les autres cellules du texte.

la ligne de code serait :

Range("A1:A10").SpecialCells(xlCellTypeConstants, 1).EntireRow.Hidden = True

Ou une seule valeur alphabétique dans plusieurs cellules, il pourrait y
avoir dans les autres cellules des valeurs numériques.

Range("A1:A10").SpecialCells(xlCellTypeConstants, 2).EntireRow.Hidden = True

Sinon, tu peux appliquer cette procédure qui est très rapide.
Elle masque toutes les lignes en une seule fois.

'--------------------------------------
Sub test()
Dim Rg As Range, Trouve As Range
Dim X As Variant, Adr As String
Dim T As String

With Feuil1
Set Rg = .Range("A1:A8")
End With

'X la valeur dont la ligne doit être masquée
X = 1
With Rg
Set Trouve = .Find(What:=X, LookIn:=xlValues, Lookat:=xlPart)
If Not Trouve Is Nothing Then
Adr = Trouve.Address
Do
T = T & "," & Trouve.Address
Set Trouve = .FindNext(Trouve)
Loop Until Trouve.Address = Adr
End If
End With
T = Right(T, Len(T) - 1)
With Feuil1
.Range(T).EntireRow.Hidden = True
End With

End Sub
'--------------------------------------

MichD

[MichD]

Le 22/04/22 à 11:18, MichD a écrit :

Légère modification afin d'éviter une erreur, si tu n’as aucune
occurrence du nombre recherché dans la plage de cellules.

'--------------------------------------
Sub test()
Dim Rg As Range, Trouve As Range
Dim X As Variant, Adr As String
Dim T As String

With Feuil1
Set Rg = .Range("A1:A8")
End With

'X la valeur dont la ligne doit être masquée
X = 1
With Rg
Set Trouve = .Find(What:=X, LookIn:=xlValues, Lookat:=xlPart)
If Not Trouve Is Nothing Then
Adr = Trouve.Address
Do
T = T & "," & Trouve.Address
Set Trouve = .FindNext(Trouve)
Loop Until Trouve.Address = Adr
End If

[MichD]

Le 24/04/22 à 18:11, MichD a écrit :

Même pas capable de faire un copier-coller correctement!

'--------------------------------------
Sub test()
Dim Rg As Range, Trouve As Range
Dim X As Variant, Adr As String
Dim T As String

With Feuil1
Set Rg = .Range("A1:A8")
End With

'X la valeur dont la ligne doit être masquée
X = 1
With Rg
Set Trouve = .Find(What:=X, LookIn:=xlValues, Lookat:=xlPart)
If Not Trouve Is Nothing Then
Adr = Trouve.Address
Do
T = T & "," & Trouve.Address
Set Trouve = .FindNext(Trouve)
Loop Until Trouve.Address = Adr

T = Right(T, Len(T) - 1)
With Feuil1
.Range(T).EntireRow.Hidden = True
End With

End If

[ThierryP]

Bonjour Denis,

Toujours ausi efficace !

Merci pour le coup de main !

ThierryP

[MichD]

Le 25/04/22 à 04:22, ThierryP a écrit :

Range(T)...

Dans la procédure soumise, il y a une limitation. La variable "T"
contenant les adresses des cellules contenant la valeur recherchée ne
peut pas excéder 255 caractères, cela limite est limitatif sur une
grande plage de cellule où la variable "T" pourrait être plus grande que
255 caractères.

La procédure suivante est aussi très rapide et elle est non limitative
sur la longueur de la chaîne de caractères contenue dans la variable T.

'-------------------------------------------

Sub test()
Dim Rg As Range, Trouve As Range
Dim X As Variant, Adr As String

Dim T As String, Sh As Worksheet

Application.ScreenUpdating = False
Application.ScreenUpdating = False

'Nom Feuille à adapter
Set Sh = Worksheets("Feuil4")

With Sh
'Plage de cellule à adapter
Set Rg = .Range("A1:A10000")

End With

'X la valeur dont la ligne doit être masquée
X = 1
With Rg

Set Trouve = .Find(What:=X, After:=Sh.Cells(Rg.Count, Rg.Column), _
LookIn:=xlValues, Lookat:=xlPart, SearchOrder:=xlNext)

If Not Trouve Is Nothing Then
Adr = Trouve.Address
Do

T = T & "," & Trouve.Address(0, 0)
Set Trouve = .FindNext(Trouve)
If Len(T) > 240 Then

T = Right(T, Len(T) - 1)

With Sh
.Range(T).EntireRow.Hidden = True
T = ""
End With
End If
If Trouve Is Nothing Then Exit Do

Loop Until Trouve.Address = Adr

If T <> "" Then

T = Right(T, Len(T) - 1)

With Sh
.Range(T).EntireRow.Hidden = True
T = ""
End With
End If
End If
End With
Application.ScreenUpdating = False
Application.ScreenUpdating = False
End Sub
'-------------------------------------------

MichD

[ThierryP]

Re-bonjour !

Oui, je m'en suis aperçu et je m'en suis sorti en déclarant T en tant que Range et tout roule !
Encore merci !

ThierryP

[MichD]

Le 25/04/22 à 08:51, ThierryP a écrit :

Tu peux publier ton code ?

MichD

[ThierryP]

Bonjour Denis,

Voici :
'-----------------------------------------------------------------
Private Sub Cache_Click()

Dim Rg As Range, Trouve As Range
Dim X As Variant, Adr As String

Dim T As Range
Application.ScreenUpdating = False
With Feuil2
Derlig = .Range("A1000000").End(xlUp).Row
DerCol = Split(Columns(.Range("$ZZ$2").End(xlToLeft).Column + 1).Address(ColumnAbsolute:=False), ":")(1)
Set Rg = .Range("$S$2:$" & DerCol & Derlig)
If Cache Then
Cache.Caption = "Tout"
With Rg
Set T = .Find(What:="x", LookIn:=xlFormulas, LookAt:=xlPart)
Set Trouve = .Find(What:="x", LookIn:=xlFormulas, LookAt:=xlPart)

If Not Trouve Is Nothing Then
Adr = Trouve.Address
Do

Set T = Union(T, Trouve)
Set Trouve = .FindNext(Trouve)

Loop Until Trouve.Address = Adr

End If
End With
T.EntireRow.Hidden = True
Else
Cache.Caption = "Non soldées"
Rg.EntireRow.Hidden = False

End If
End With
End Sub

'-------------------------------------------------------------

ThierryP

[MichD]

Le 26/04/22 à 01:54, ThierryP a écrit :

Bonjour,

C'est bien. Le seul bémol, c'est cette ligne de code:

Set T = Union(T, Trouve)

Lorsque tu augmentes l'étendue de la plage "T", cela (union) augmente le
temps d'exécution. Ça va pour une petite plage.

MichD

[ThierryP]

re-bonjour Denis,

Le "C'est bien" de la part d'un gourou, "it makes my day " !!!! :-) :-)
Tu as sûrement raison, mais dans le fichier que j'ai créé, il y aura au maximum quelques centaines de lignes et la différence n'est pas visible à l'oeil nu !

Et comme c'est une appli "propriétaire", je ne me préoccupe pas trop de la rendre "portable" !
Merci pour ton retour,