XL 2019 Excel 2019 VBA macro masquer lignes et colonnes vides

[sofmat]

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.

 

[job75]

Dans ce fichier (3) j'utilise :

If Application.CountIf(r, "><") + Application.CountIf(r, ">0") + Application.CountIf(r, "<0") = 0 Then r.Hidden = True

C'est un peu plus rapide : 0,37 seconde au lieu de 0,45 seconde.

 

[job75]

Une macro nettement plus rapide dans ce fichier (4) :

Sub Masquer()
Dim P As Range, a(), i&, r As Range
Application.ScreenUpdating = False
On Error Resume Next 'si aucune SpecialCell
Rows.Hidden = False
Columns.Hidden = False
Set P = ActiveSheet.UsedRange
'---lignes---
ReDim a(1 To P.Rows.Count, 1 To 1) 'matrice, plus rapide
For i = 1 To UBound(a)
    Set r = P.Rows(i)
    a(i, 1) = Application.CountIf(r, "><") + Application.CountIf(r, ">0") + Application.CountIf(r, "<0")
    If a(i, 1) = 0 Then a(i, 1) = "#N/A"
Next
With P.Columns(P.Columns.Count + 1) 'colonne auxiliaire suivant la dernière colonne
    .Value = a 'restitution
    .SpecialCells(xlCellTypeConstants, 16).EntireRow.Hidden = True 'masque en bloc
    .ClearContents 'efface la colonne auxiliaire
End With
'---colonnes---
ReDim a(1 To 1, 1 To P.Columns.Count) 'matrice, plus rapide
For i = 1 To UBound(a, 2)
    Set r = P.Columns(i)
    a(1, i) = Application.CountIf(r, "><") + Application.CountIf(r, ">0") + Application.CountIf(r, "<0")
    If a(1, i) = 0 Then a(1, i) = "#N/A"
Next
With P.Rows(P.Rows.Count + 1) 'ligne auxiliaire suivant la dernière ligne
    .Value = a 'restitution
    .SpecialCells(xlCellTypeConstants, 16).EntireColumn.Hidden = True 'masque en bloc
    .ClearContents 'efface la ligne auxiliaire
End With
End Sub

Les lignes et colonnes sont masquées en bloc à l'aide de colonne et ligne auxiliaires.

Chez moi la macro s'exécute en 0,018 seconde, c'est 20 fois plus rapide.

 

[job75]

Bonjour le fil, le forum,

J'ai modifié la macro précédente : au lieu d'insérer une colonne ou ligne auxiliaire j'utilise simplement la colonne qui suit la dernière colonne et la ligne qui suit la dernière ligne du UsedRange.

C'est encore plus rapide.

A+

 

[sofmat]

Bonjour le fil, le forum,

J'ai modifié la macro précédente : au lieu d'insérer une colonne ou ligne auxiliaire j'utilise simplement la colonne qui suit la dernière colonne et la ligne qui suit la dernière ligne du UsedRange.

C'est encore plus rapide.

A+

C'est ultra parfait! Merci beaucoup pour votre aide. Bonne journée

 

[sofmat]

C'est ultra parfait! Merci beaucoup pour votre aide. Bonne journée

J'essaie de modifier le code ci-dessus qui marche très bien et qui est très rapide mais je n'arrive pas à atteindre ce qu'il me faut. En fait, il ne faut pas tout masquer : il ne faut pas masquer les 2 premières lignes : il faut masquer de la ligne 3 à la ligne 183. Et il faut que cela ne s'adresse qu'à deux onglets de mon classeur :"plan" et "Rectification". Pouvez-vous m'aider svp.

 

[job75]

Bonjour softmat,

il faut masquer de la ligne 3 à la ligne 183.

Eh bien utilisez :

Set P = Intersect([3:183], ActiveSheet.UsedRange)

et exécutez la macro sur les onglets que vous voulez.

A+

 

[sofmat]

Merci pour votre réponse. Cela ne fonctionne pas. La ligne 1 à 3 s'affiche bien mais il y'a un problème sur les colonnes.

 

[job75]

Quel problème ?

 

[sofmat]

Cela affiche de la ligne 1 à 4 puis la ligne 8, 48, 88 et uniquement la colonne A, QZ, RD, AJB alors qu'il y'a des données dans les colonnes et elles ne s'affichent plus. En fait les lignes à masquer si elles sont vides commencent à la ligne A4 pour se terminer à la ligne 183 (les colonnes peuvent aller jusqu'à AJA183). merci !

 

[job75]

Les lignes contenant des zéros ou des espaces sont aussi masquées.

Vous dites qu'il y a des données qui ne s'affichent plus, quelles données ?

 

[sofmat]

Je vous joins un fichier, ce sera plus simple. Merci

 

[job75]

Bon dans le fichier joint je ne modifie plus P et juste ajouté après le traitement des lignes :

Rows("1:3").Hidden = False
Rows("184:" & Rows.Count).Hidden = False

et modifié les propriétés de l'image pour que ses dimensions ne changent pas.

 

[sofmat]

Super
C'est exactement ce qu'il me faut. Merci beaucoup. J'ai une autre question si je peux me permettre. Je voudrai combiner votre macro avec une autre macro mais je ne sais pas si c'est possible. Je vous explique. Je voudrai que la macro masque automatiquement deux onglets différents (qui se nomment "Mesure pour client" et "plan" puis qu'elle sauvegarde le tout en pdf. Sachant que le nom d'enregistrement du pdf contient des variables d'un onglet et que les onglets du pdf ne se suivent pas. Je ne sais pas si c'est possible... Merci

La macro que j'utilise pour le pdf :

Sub sauve_revision_periodique_pdf()
    Dim ArraySheet, chemin$, WbK As Workbook, F, Nom$, sh    'variables

    Application.ScreenUpdating = False    'bloque le rafraichissement d'écran

    ArraySheet = Array("Révision périodique", "Mesure pour client", "Plan", "lettre_rev_periodique")

   chemin = "\\Freebox_Server\serveur maison\Fichiers Maison\Kylian\VISION\CLIENTS\CONTROLE VOILES" & "/"

    Set sh = Sheets("Révision périodique")

    With sh
        Nom = .Range("C11") & " " & .Range("P11") & " - " & .Range("P7") & " - " & .Range("H17") & " - " & .Range("P17") & " - " & _
              .Range("W17") & " - " & .Range("C19") & " - " & .Range("c17") & " - " & .Range("c7").Value & " - " & _
              Format(Date, "dd.mm.yyyy") & ".pdf"
    End With


    Set WbK = Workbooks.Add    'on ajoute un classeur temporaire

    For Each F In ArraySheet  'boucle sur l'array et copie des feuille dans le nouveau classeur
        ThisWorkbook.Sheets(F).Copy after:=WbK.Sheets(WbK.Sheets.Count)
    Next

    Application.DisplayAlerts = False
    WbK.Sheets(1).Delete    'on supprime la feuil1 qui est créée automatiquement a la creation du classeur

    'on sauve en pdf
    WbK.ExportAsFixedFormat Type:=xlTypePDF, Filename:=chemin & Nom, Quality:=xlQualityStandard, _
                            IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
                            True
    'on ferme le classeur temporaire 'on ne le sauve pas
    WbK.Close False

End Sub

 

[job75]

Voyez le fichier zippé joint et cette nouvelle macro qui traite 2 feuilles :

Sub Masquer_PDF()
Dim feuille, f As Worksheet, P As Range, a(), i&, r As Range
Application.ScreenUpdating = False
On Error Resume Next 'si aucune SpecialCell
Set feuille = Sheets(Array("plan", "Mesure pour client"))
For Each f In feuille
    f.PageSetup.PrintArea = "A1:AJI189"
    f.Rows.Hidden = False
    f.Columns.Hidden = False
    Set P = f.UsedRange
    '---lignes---
    ReDim a(1 To P.Rows.Count, 1 To 1) 'matrice, plus rapide
    For i = 1 To UBound(a)
        Set r = P.Rows(i)
        a(i, 1) = Application.CountIf(r, "><") + Application.CountIf(r, ">0") + Application.CountIf(r, "<0")
        If a(i, 1) = 0 Then a(i, 1) = "#N/A"
    Next i
    With P.Columns(P.Columns.Count + 1) 'colonne auxiliaire suivant la dernière colonne
        .Value = a 'restitution
        .SpecialCells(xlCellTypeConstants, 16).EntireRow.Hidden = True 'masque en bloc
        .ClearContents 'efface la colonne auxiliaire
    End With
    f.Rows("1:3").Hidden = False
    f.Rows("184:" & f.Rows.Count).Hidden = False
    '---colonnes---
    ReDim a(1 To 1, 1 To P.Columns.Count) 'matrice, plus rapide
    For i = 1 To UBound(a, 2)
        Set r = P.Columns(i)
        a(1, i) = Application.CountIf(r, "><") + Application.CountIf(r, ">0") + Application.CountIf(r, "<0")
        If a(1, i) = 0 Then a(1, i) = "#N/A"
    Next i
    With P.Rows(P.Rows.Count + 1) 'ligne auxiliaire suivant la dernière ligne
        .Value = a 'restitution
        .SpecialCells(xlCellTypeConstants, 16).EntireColumn.Hidden = True 'masque en bloc
        .ClearContents 'efface la ligne auxiliaire
    End With
Next f
'---PDF---
feuille.Select
ActiveSheet.ExportAsFixedFormat xlTypePDF, ThisWorkbook.Path & "\Fichier PDF.pdf", OpenAfterPublish:=False
feuille(1).Select
End Sub

 

[sofmat]

Merci beaucoup! Bonne journée