XL 2016 Macro masquer ligne avec 2 conditions

konzo · 21 Juin 2020

Bonsoir Cher Tous
A partir des contributions du forum j'ai créé un code pour masquer/démasquer des lignes qui ont zéro pour des plages spécifiques entre H9 à I281
Je veux modifier le code pour masquer/démasquer les lignes si les cellules des colonnes H et I sont égales à zéro.
Par exemple : Masquer la ligne entière uniquement Si cellules H9 = 0 et I9 = 0.
Fichier en attache
Merci d'avance pour tout appui
Ci-dessous le code existant :

VB:

Private Sub CommandButton1_Click()
Dim xcell, etat As Boolean
   Application.ScreenUpdating = False
   For Each xcell In Range("H9:I33,H37:I58,H62:I98,H107:I142,H146:I160,H164:I184,H188:I195,H197:I264,H266:I281")
      If xcell = 0 Then xcell.EntireRow.Hidden = True
   Next xcell
End Sub

Private Sub CommandButton2_Click()
Range("H9:I33,H37:I58,H62:I98,H107:I142,H146:I160,H164:I184,H188:I195,H197:I264,H266:I281").EntireRow.Hidden = False
End Sub

cp4 · 21 Juin 2020

😉

konzo à dit:
cp4,
Exactement mon code était très lent. C'est le travail d'un débutant😀😀
Ton code est excellent.
Les lignes avec titre, Sous-titre, Sous-total et Total ne doivent être masqués.
Comment les exclure de la sélection?
Cordialement

Code à tester

VB:

Private Sub CommandButton1_Click()
'Les lignes avec titre, Sous-titre, Sous-total et Total ne doivent être masqués.
   Dim xcell, dl As Long, plage As Range
   'determine la dernière ligne de données
   Set plage = ActiveSheet.UsedRange
   For Each xcell In plage.Cells
      If Not IsEmpty(xcell) Then dl = xcell.Row
   Next

   Application.ScreenUpdating = False
   'masque ligne si h=0 et i =0
   For Each xcell In ActiveSheet.Range("A8:A" & dl)
      If xcell.MergeArea.Address =...

eriiic · 21 Juin 2020

Bonjour,

VB:

If xcell = 0 and xcell.offset(,1) = 0 Then

eric

cp4 · 21 Juin 2020

Bonjour Konzo, le forum

à tester

VB:

Private Sub CommandButton1_Click()
   Dim xcell, dl As Long, plage As Range
   'determine la dernière ligne de données
   Set plage = ActiveSheet.UsedRange
   For Each xcell In plage.Cells
      If Not IsEmpty(xcell) Then dl = xcell.Row
   Next

   Application.ScreenUpdating = False
'masque ligne si h=0 et i =0
   For Each xcell In ActiveSheet.Range("h8:h" & dl)
      If xcell = 0 And xcell.Offset(, 1) = 0 Then xcell.EntireRow.Hidden = True
   Next xcell
   Application.ScreenUpdating = True
   Set plage = Nothing
End Sub

Private Sub CommandButton2_Click()
Range("H:I").EntireRow.Hidden = False
End Sub

edit: Bonjour eric 😉 pas vu.
@konzo: precedent code plus lent car prenez en compte lignes jusqu'à 26929
donc code réédité.

konzo · 21 Juin 2020

eriiiic à dit:
Bonjour,

VB:

If xcell = 0 and xcell.offset(,1) = 0 Then

eric

Eric,
Merci beaucoup pour ta réponse

konzo · 21 Juin 2020

cp4 à dit:

Bonjour Konzo, le forum

à tester

VB:

Private Sub CommandButton1_Click()
   Dim xcell, dl As Long, plage As Range
   'determine la dernière ligne de données
   Set plage = ActiveSheet.UsedRange
   For Each xcell In plage.Cells
      If Not IsEmpty(xcell) Then dl = xcell.Row
   Next

   Application.ScreenUpdating = False
'masque ligne si h=0 et i =0
   For Each xcell In ActiveSheet.Range("h8:h" & dl)
      If xcell = 0 And xcell.Offset(, 1) = 0 Then xcell.EntireRow.Hidden = True
   Next xcell
   Application.ScreenUpdating = True
   Set plage = Nothing
End Sub

Private Sub CommandButton2_Click()
Range("H:I").EntireRow.Hidden = False
End Sub

edit: Bonjour eric 😉 pas vu.
@konzo: precedent code plus lent car prenez en compte lignes jusqu'à 26929
donc code réédité.

Bonjour cp4
Merci beaucoup. Je vais tester et te revenir.
Bon dimanche à tous

konzo · 21 Juin 2020

konzo à dit:
Bonjour cp4
Merci beaucoup. Je vais tester et te revenir.
Bon dimanche à tous

cp4,
Exactement mon code était très lent. C'est le travail d'un débutant😀😀
Ton code est excellent.
Les lignes avec titre, Sous-titre, Sous-total et Total ne doivent être masqués.
Comment les exclure de la sélection?
Cordialement

cp4 · 21 Juin 2020

😉

konzo à dit:
cp4,
Exactement mon code était très lent. C'est le travail d'un débutant😀😀
Ton code est excellent.
Les lignes avec titre, Sous-titre, Sous-total et Total ne doivent être masqués.
Comment les exclure de la sélection?
Cordialement

Code à tester

VB:

Private Sub CommandButton1_Click()
'Les lignes avec titre, Sous-titre, Sous-total et Total ne doivent être masqués.
   Dim xcell, dl As Long, plage As Range
   'determine la dernière ligne de données
   Set plage = ActiveSheet.UsedRange
   For Each xcell In plage.Cells
      If Not IsEmpty(xcell) Then dl = xcell.Row
   Next

   Application.ScreenUpdating = False
   'masque ligne si h=0 et i =0
   For Each xcell In ActiveSheet.Range("A8:A" & dl)
      If xcell.MergeArea.Address = xcell.Address Then
         If IsNumeric(xcell) Then
            If xcell.Offset(, 7) = 0 And xcell.Offset(, 8) = 0 Then xcell.EntireRow.Hidden = True
         End If
      End If
   Next xcell
   Application.ScreenUpdating = True
   Set plage = Nothing
End Sub

Bonne soirée.

konzo · 21 Juin 2020

cp4 à dit:

😉

Code à tester

VB:

Private Sub CommandButton1_Click()
'Les lignes avec titre, Sous-titre, Sous-total et Total ne doivent être masqués.
   Dim xcell, dl As Long, plage As Range
   'determine la dernière ligne de données
   Set plage = ActiveSheet.UsedRange
   For Each xcell In plage.Cells
      If Not IsEmpty(xcell) Then dl = xcell.Row
   Next

   Application.ScreenUpdating = False
   'masque ligne si h=0 et i =0
   For Each xcell In ActiveSheet.Range("A8:A" & dl)
      If xcell.MergeArea.Address = xcell.Address Then
         If IsNumeric(xcell) Then
            If xcell.Offset(, 7) = 0 And xcell.Offset(, 8) = 0 Then xcell.EntireRow.Hidden = True
         End If
      End If
   Next xcell
   Application.ScreenUpdating = True
   Set plage = Nothing
End Sub

Bonne soirée.

Eric,
Excellent travail et merci beaucoup
Cordialement à toi

XL 2016 Macro masquer ligne avec 2 conditions

konzo

XLDnaute Nouveau

Pièces jointes

cp4

eriiic

XLDnaute Barbatruc

cp4

XLDnaute Barbatruc

konzo

XLDnaute Nouveau

konzo

XLDnaute Nouveau

konzo

XLDnaute Nouveau

cp4

XLDnaute Barbatruc

konzo

XLDnaute Nouveau

Discussions similaires

XL 2016 Macro masquer ligne avec 2 conditions

XLDnaute Nouveau

Pièces jointes

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Nouveau

XLDnaute Nouveau

XLDnaute Nouveau

XLDnaute Barbatruc

XLDnaute Nouveau

Discussions similaires

Privacy & Transparency

Privacy & Transparency