XL 2013 effacre ligne et colonne vides

[coco1969]

Bonjour à tous,
Quelqu'un pourrais m'aider, j'aimerais éliminer les lignes et colonnes vide d'un rapport qui m'a été envoyé MAIS pas trop pratique à utiliser .
Pourriez-vous SVP y insérer le code VBA ou autre afin que je visualise dans le fichier existant SI cela n'est pas trop demander ?????

 

[riton00]

Bonjour à tous

A défaut d'une meilleur proposition, je te propose déjà de voir ce lien
www.pcastuces.com/pratique/astuces/4283.htm

 

[Robert]

Bonjour Coco, Riton, bonjour le forum,

Essaie ce code :

Sub Macro1()
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim PL As Range 'déclare la variable PL (PLage)
Dim NC As Range 'déclare la variable NC (Nombre de Colonnes)
Dim I As Range 'déclare la variable I (Incrément)
Dim NL As Range 'déclare la variable NL (Nombre de Lignes)

Set O = Worksheets("Sheet1") 'définit l'onglet O
Set PL = O.UsedRange 'définit la plage PL
NC = PL.Columns.Count 'définit le nombre de colonnes NC de la plage PL
For I = NL To 1 Step -1 'boucle inversée sur toutes les lignes I de la plage PL (de la dernière à la première)
    'si le nombre de cellules vide de la ligne I est égale au nombre de colonne NC, supprime la ligne
    If Application.WorksheetFunction.CountBlank(PL.Rows(I)) = NC Then PL.Rows(I).EntireRow.Delete
Next I 'prochaine ligne de la boucle
NL = PL.Rows.Count 'définit le nombre de lignes NL de la plage PL
For I = NC To 1 Step -1 'boucle inversée sur toutes les colonnes I de la plage PL (de la dernière à la première)
    'si le nombre de cellules vide de la colonne I est égale au nombre de lignes NL, supprime la colonne
    If Application.WorksheetFunction.CountBlank(PL.Columns(I)) = NL Then PL.Columns(I).EntireColumn.Delete
Next I 'prochaine colonne de la boucle
End Sub

 

[Si...]

Bonjour

salut Robert , pour les variables numériques, les déclarer plutôt ainsi, non ?​

Dim NC As Long 'déclare la variable NC (Nombre de Colonnes)
Dim I As Long 'déclare la variable I (Incrément)
Dim NL As Long 'déclare la variable NL (Nombre de Lignes)

Au revoir

 

[Robert]

Re,

Bien sûr SI ! Copié/Collé mal relus et surtout pas corrigé...Heureusement que tu veilles au grain ! Merci...

 

[job75]

Bonjour coco1969, riton00, Robert, Si...

La suppression des lignes ou colonnes une par une peut prendre beaucoup de temps si elles sont nombreuses.

Avec cette macro c'est bien plus rapide :

Sub SupprimerLignesColonnesVides()
Application.ScreenUpdating = False
On Error Resume Next 'pour les SpecialCells si aucune valeur d'erreur
With ActiveSheet.UsedRange
  '---suppression des colonnes vides---
  .Rows(.Rows.Count + 1) = "=1/SIGN(COUNTA(R1C:R[-1]C))"
  .Rows(.Rows.Count + 1) = .Rows(.Rows.Count + 1).Value 'supprime les formules
  .Resize(.Rows.Count + 1).Sort .Rows(.Rows.Count + 1), xlAscending, Orientation:=xlLeftToRight 'tri pour accélérer
  .Rows(.Rows.Count + 1).SpecialCells(xlCellTypeConstants, 16).EntireColumn.Delete
  .Rows(.Rows.Count + 1).ClearContents
  '---suppression des lignes vides---
  .Columns(.Columns.Count + 1) = "=1/SIGN(COUNTA(RC1:RC[-1]))"
  .Columns(.Columns.Count + 1) = .Columns(.Columns.Count + 1).Value 'supprime les formules
  .Resize(, .Columns.Count + 1).Sort .Columns(.Columns.Count + 1), xlAscending, Orientation:=xlTopToBottom 'tri pour accélérer
  .Columns(.Columns.Count + 1).SpecialCells(xlCellTypeConstants, 16).EntireRow.Delete
  .Columns(.Columns.Count + 1).ClearContents
End With
With ActiveSheet.UsedRange: End With 'actualise les barres de défilement
End Sub

Fichier joint.

A+

 

[job75]

Re,

Si l'on veut conserver les hauteurs des lignes il suffit de modifier légèrement le tri vertical :

  .EntireRow.Sort .Columns(.Columns.Count + 1), xlAscending, Orientation:=xlTopToBottom 'tri pour accélérer

Fichier (2).

Bonne nuit.

 

[coco1969]

Bonjour coco1969, riton00, Robert, Si...

La suppression des lignes ou colonnes une par une peut prendre beaucoup de temps si elles sont nombreuses.

Avec cette macro c'est bien plus rapide :

Sub SupprimerLignesColonnesVides()
Application.ScreenUpdating = False
On Error Resume Next 'pour les SpecialCells si aucune valeur d'erreur
With ActiveSheet.UsedRange
  '---suppression des colonnes vides---
  .Rows(.Rows.Count + 1) = "=1/SIGN(COUNTA(R1C:R[-1]C))"
  .Rows(.Rows.Count + 1) = .Rows(.Rows.Count + 1).Value 'supprime les formules
  .Resize(.Rows.Count + 1).Sort .Rows(.Rows.Count + 1), xlAscending, Orientation:=xlLeftToRight 'tri pour accélérer
  .Rows(.Rows.Count + 1).SpecialCells(xlCellTypeConstants, 16).EntireColumn.Delete
  .Rows(.Rows.Count + 1).ClearContents
  '---suppression des lignes vides---
  .Columns(.Columns.Count + 1) = "=1/SIGN(COUNTA(RC1:RC[-1]))"
  .Columns(.Columns.Count + 1) = .Columns(.Columns.Count + 1).Value 'supprime les formules
  .Resize(, .Columns.Count + 1).Sort .Columns(.Columns.Count + 1), xlAscending, Orientation:=xlTopToBottom 'tri pour accélérer
  .Columns(.Columns.Count + 1).SpecialCells(xlCellTypeConstants, 16).EntireRow.Delete
  .Columns(.Columns.Count + 1).ClearContents
End With
With ActiveSheet.UsedRange: End With 'actualise les barres de défilement
End Sub

Fichier joint.

A+

Super Un grand merci c'est exactement ce don't j'ai besoin

 

[job75]

Bonjour coco1969, le forum,

Le tri horizontal ne permet pas de conserver les largeurs des colonnes.

S'il n'y a pas un trop grand nombre de colonnes il suffit de ne pas effectuer ce tri.

Fichier (2 bis).

Bonne journée.

 

[job75]

Re,

Noter que si une ou plusieurs cellules sont fusionnées le ou les tris ne peuvent s'exécuter.

Sur ce fichier (2 ter) la suppression s'effectue en 142 secondes chez moi (Win 10 - Excel 2013).

A+