XL 2019 Excel 2019 VBA macro masquer lignes et colonnes vides

sofmat · 19 Mars 2023

Bonjour, J'essaie de masquer toutes les colonnes et lignes vides de mon tableau sur excel 2019. Concernant les colonnes, j'ai trouvé une macro qui fonctionne mais j'aimerai que cette macro masque également les lignes vides. J'ai testé une deuxième macro pour les lignes vides mais cela ne fonctionne pas. De plus j'aurai aimé n'avoir qu'une seule macro qui masque les lignes et les colonnes vides. Pouvez-vous m'aider ? Merci beaucoup.

vgendron · 19 Mars 2023

Bonjour

il te suffisait de reproduire ta macro "masquer colonne"

VB:

Sub Cacher_lignevide()
Dim cellule As Range

Application.ScreenUpdating = False
Rows("1:190").Hidden = False

For i = 1 To 190
    Masquer = True
    For Each Cel In Cells(i, 1).Resize(1, 200).SpecialCells(xlCellTypeVisible)
        If Val(Cel.Value) > 0 Or (Cel.Value) <> "" Then
            Masquer = False
            Exit For
        End If
    Next Cel
    If Masquer Then Rows(i).Hidden = True
Next i
Application.ScreenUpdating = True
End Sub

sofmat · 19 Mars 2023

Bonjour, Cela ne masque pas toutes les lignes vides et je voudrai imbriquer la fonction de masquer les lignes et les colonnes en même temps. Merci

vgendron · 19 Mars 2023

bah si ca marche !
si tu masques les colonnes puis les lignes ca marche très bien
et si tu veux mettre les fonctions en meme temps.. suffit de déplacer le code dans la meme macro que masquer colonne

ou alors tu fais une macro qui appelle successivement les deux macros de masquage

vgendron · 19 Mars 2023

remplace par ce code: pour ne plus afficher les lignes qui contiennent autre chose que des valeurs

VB:

Sub Cacher_lignevide()
Dim cellule As Range

Application.ScreenUpdating = False
Rows("1:190").Hidden = False

For i = 1 To 190
    Masquer = True
    For Each Cel In Cells(i, 1).Resize(1, 200).SpecialCells(xlCellTypeVisible)
        If Val(Cel.Value) > 0 Then 'Or (Cel.Value) <> ""
            Masquer = False
            Exit For
        End If
    Next Cel
    If Masquer Then Rows(i).Hidden = True
Next i
Application.ScreenUpdating = True
End Sub

Staple1600 · 19 Mars 2023

Bonjour le fil

vgendron
Si tu mets cette formule en colonne GJ
=NBVAL(A1:GI1)
Tu n'obtiens 0 qu'à partir de la cellule GJ91

Donc les lignes au dessus qui semblent vides ne sont pas masquées.

NB: Sauf erreur, les codes des messages #2 et #5 sont les mêmes, non ?

vgendron · 19 Mars 2023

bon pour faire simple
la macro qui masque les colonnes, postée par le demandeur garde les colonnes dans lesquelles il y a au moins une valeur ==> que du texte=colonne masquée

je me suis donc contenté de faire la meme chose pour les lignes
sauf que j'avais ajouté une condition "if cel.value<>""
ce qui laissait les lignes contenant que du texte (post 2)

j'ai corrigé en post 5 (qui n'est donc pas le meme que le 2) pour masquer les lignes ne contenant QUE du texte

au final, les deux macros masquer colonne + masquer ligne me donne
6 lignes affichées et 27 colonnes

Staple1600 · 19 Mars 2023

Re

vgendron
J'ai plus 20 ans
Et un guillemet isolé au milieu d'une ligne de code, bah, je le vois plus
Désolé pour le dérangement

J'en profite pour confirme que le masquage se fait bien (ligne et colonne)

Par contre, ce faisant, j'ai tué mon Excel
(je devais avoir trop de classeurs ouverts)

sylvanu · 19 Mars 2023

Bonjour Softmat, Vgendron, Staple,
Un essai en PJ avec :

VB:

Sub Masquage()
    Application.ScreenUpdating = False
    Cells.EntireRow.Hidden = False
    Cells.EntireColumn.Hidden = False
    Lmax = 90: Cmax = 191               ' A adapter
    For L = 1 To Lmax
        Set Plage = Range(Cells(L, 1), Cells(L, Cmax))
        If Application.CountIf(Plage, "><") + Application.CountIf(Plage, ">0") = 0 Then Rows(L).Hidden = True
    Next L
    For C = 1 To Cmax
        Set Plage = Range(Cells(1, C), Cells(Lmax, C))
        If Application.CountIf(Plage, "><") + Application.CountIf(Plage, ">0") = 0 Then Columns(C).Hidden = True
    Next C
End Sub

fanch55 · 19 Mars 2023

Bonjour à tous,
Une autre méthode à tester

VB:

Sub Hide_Empty_Rows_And_Columns()
    Dim Lastcell As Range: Set Lastcell = ActiveSheet.UsedRange.SpecialCells(xlLastCell)
    Dim C: For C = Lastcell.Column To 1 Step -1
        Select Case True
        Case ActiveSheet.Columns(C).Hidden
        Case WorksheetFunction.CountA(ActiveSheet.Columns(C)) > 0
        Case Else: ActiveSheet.Columns(C).EntireColumn.Hidden = True
        End Select
    Next
    Dim R: For R = Lastcell.Row To 1 Step -1
        Select Case True
        Case ActiveSheet.Rows(R).Hidden
        Case WorksheetFunction.CountA(ActiveSheet.Rows(R)) > 0
        Case Else: ActiveSheet.Rows(R).EntireRow.Hidden = True
        End Select
    Next
End Sub

Staple1600 · 19 Mars 2023

Re

Merci sylvanu
Je me suis souvenu
(oui ca rime )

VB:

Sub Masquer_Lignes()
Application.ScreenUpdating = False
'basée sur l'idée de Sylvanu
Range("GJ1:GJ190") = "=IF(COUNTIF(RC[-191]:RC[-1],""><"")+COUNTIF(RC[-191]:RC[-1],"">0"")=0,""$$$"",0)"
Range("GJ1:GJ190") = Range("GJ1:GJ190").Value
Range("GJ1:GJ190").SpecialCells(xlCellTypeConstants, 2).EntireRow.Hidden = True
Range("GJ1:GJ190") = ""
End Sub

fanch55 · 19 Mars 2023

Pour développer et compléter le "Total recall" de @Staple1600 :

VB:

Sub Masquer_Lignes_et_Colonnes()
Application.ScreenUpdating = False
'basée sur l'idée de Sylvanu
    C = ActiveSheet.UsedRange.Columns.Count + 2
    With Range(Cells(1, C), Cells(ActiveSheet.UsedRange.Rows.Count, C))
        Plage = "A1:" & Cells(1, C - 2).Address(False, False)
        .FormulaLocal = "=SI(NB.SI(" & Plage & ";""><"")+NB.SI(" & Plage & ";"">0"")=0;""$$$"";0)"
        .Value = .Value
        .SpecialCells(xlCellTypeConstants, xlTextValues).EntireRow.Hidden = True
        .Clear
    End With
    
    R = ActiveSheet.UsedRange.Rows.Count + 2
    With Range(Cells(R, 1), Cells(R, ActiveSheet.UsedRange.Columns.Count))
        Plage = "A1:" & Cells(R - 2, 1).Address(False, False)
        .FormulaLocal = "=SI(NB.SI(" & Plage & ";""><"")+NB.SI(" & Plage & ";"">0"")=0;""$$$"";0)"
        .Value = .Value
        .SpecialCells(xlCellTypeConstants, xlTextValues).EntireColumn.Hidden = True
        .Clear
    End With
End Sub

Ce qui ne fait guère moins de lignes que mon post #10, mais peut-être et surement moins de temps ...

job75 · 19 Mars 2023

Bonjour à tous,

Testez :

VB:

Sub Masquer()
Dim r As Range
Application.ScreenUpdating = False
Rows.Hidden = False
Columns.Hidden = False
For Each r In ActiveSheet.UsedRange.Rows
    If Evaluate("SUMPRODUCT((TRIM(" & r.Address & ")<>"""")*(" & r.Address & "<>0))") = 0 Then r.Hidden = True
Next
For Each r In ActiveSheet.UsedRange.Columns
    If Evaluate("SUMPRODUCT((TRIM(" & r.Address & ")<>"""")*(" & r.Address & "<>0))") = 0 Then r.Hidden = True
Next
End Sub

Les lignes ou colonnes qui sont vides ou ne contiennent que des textes vides "", espaces ou zéros sont masquées.

A+

job75 · 19 Mars 2023

On comprendra un peu mieux ce qui se passe si l'on supprime la MFC qui masque les valeurs zéro.

job75 · 19 Mars 2023

Si la feuille contient des valeurs d'erreur (exemple en A1) il y a bug avec ma macros précédente.

Pour y remédier utiliser CStr :

VB:

Sub Masquer()
Dim r As Range
Application.ScreenUpdating = False
Rows.Hidden = False
Columns.Hidden = False
For Each r In ActiveSheet.UsedRange.Rows
    If CStr(Evaluate("SUMPRODUCT((TRIM(" & r.Address & ")<>"""")*(" & r.Address & "<>0))")) = "0" Then r.Hidden = True
Next
For Each r In ActiveSheet.UsedRange.Columns
    If CStr(Evaluate("SUMPRODUCT((TRIM(" & r.Address & ")<>"""")*(" & r.Address & "<>0))")) = "0" Then r.Hidden = True
Next
End Sub

XL 2019 Excel 2019 VBA macro masquer lignes et colonnes vides

sofmat

XLDnaute Junior

Pièces jointes

vgendron

XLDnaute Barbatruc

sofmat

XLDnaute Junior

vgendron

XLDnaute Barbatruc

vgendron

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

vgendron

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

sylvanu

XLDnaute Barbatruc

Pièces jointes

fanch55

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

fanch55

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

Pièces jointes

job75

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

Pièces jointes

Discussions similaires