XL 2010 effacer lignes vides sous condition

cgpa

XLDnaute Occasionnel
Bonjour,
Plusieurs posts traitent de mon problème mais je ne parviens pas à trouver la solution: je désire effacer toutes les lignes vides d'une plage d'un tableau nommé à la condition que l'entièreté de la ligne soit vide. Autrement dit, que même si une cellule de la première colonne est vide mais pas la suivante, la ligne reste visible.
J'ai deux tests de codes en module, mais aucun des deux ne fonctionne selon cette condition. Je référence mal le nom de mon tableau. Pouvez-vous m'éclairer? Merci pour votre aide.
 

Pièces jointes

  • efface vides.xlsm
    18.9 KB · Affichages: 6
Solution
Bonjour cgpa, sylvanu,

Une méthode classique dans le fichier joint, elle utilise une colonne auxiliaire :
VB:
Sub suppr_vides()
Application.ScreenUpdating = False
With [Tableau16]
    .Columns(.Columns.Count).EntireColumn.Insert 'insère une colonne auxiliaire
    .Columns(.Columns.Count - 1) = "=1/SIGN(COUNTA(" & .Cells(1).Resize(, .Columns.Count - 2).Address(0, 0) & "))"
    .Columns(.Columns.Count - 1) = .Columns(.Columns.Count - 1).Value 'supprime les formules
    .Sort .Columns(.Columns.Count - 1), Header:=xlYes 'tri pour accélérer, place les valeurs d'erreur en bas
    On Error Resume Next 'si aucune SpecialCell
    Intersect(.Columns(.Columns.Count - 1).SpecialCells(xlCellTypeConstants, 16).EntireRow, .Cells).Delete xlUp...

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour Cgpa,
Un essai en PJ avec la petite macro :
VB:
Sub supprLigne()
Application.ScreenUpdating = False
N = Application.CountIf(Range("Tableau16[Prix total]"), ">=0")
With Sheets("Feuil1")
For i = N To 1 Step -1
    Vide = 0
    For j = 1 To 5
        If Range("Tableau16").Cells(i, j) <> "" Then Vide = 1       ' Si Vide=1 alors c'est que la ligne n'est pas vide
    Next j
    If Vide = 0 Then Range("Tableau16").Cells(i, 1).EntireRow.Delete
Next i
End With
End Sub
 

Pièces jointes

  • efface vides.xlsm
    28.7 KB · Affichages: 7

job75

XLDnaute Barbatruc
Bonjour cgpa, sylvanu,

Une méthode classique dans le fichier joint, elle utilise une colonne auxiliaire :
VB:
Sub suppr_vides()
Application.ScreenUpdating = False
With [Tableau16]
    .Columns(.Columns.Count).EntireColumn.Insert 'insère une colonne auxiliaire
    .Columns(.Columns.Count - 1) = "=1/SIGN(COUNTA(" & .Cells(1).Resize(, .Columns.Count - 2).Address(0, 0) & "))"
    .Columns(.Columns.Count - 1) = .Columns(.Columns.Count - 1).Value 'supprime les formules
    .Sort .Columns(.Columns.Count - 1), Header:=xlYes 'tri pour accélérer, place les valeurs d'erreur en bas
    On Error Resume Next 'si aucune SpecialCell
    Intersect(.Columns(.Columns.Count - 1).SpecialCells(xlCellTypeConstants, 16).EntireRow, .Cells).Delete xlUp
    .Columns(.Columns.Count - 1).EntireColumn.Delete 'suppression de la colonne auxiliaire
End With
End Sub
La macro est très rapide sur un grand tableau car cellui-ci est trié avant suppression des lignes.

A+
 

Pièces jointes

  • efface vides(1).xlsm
    20 KB · Affichages: 7

cgpa

XLDnaute Occasionnel
Bonjour Cgpa,
Un essai en PJ avec la petite macro :
VB:
Sub supprLigne()
Application.ScreenUpdating = False
N = Application.CountIf(Range("Tableau16[Prix total]"), ">=0")
With Sheets("Feuil1")
For i = N To 1 Step -1
    Vide = 0
    For j = 1 To 5
        If Range("Tableau16").Cells(i, j) <> "" Then Vide = 1       ' Si Vide=1 alors c'est que la ligne n'est pas vide
    Next j
    If Vide = 0 Then Range("Tableau16").Cells(i, 1).EntireRow.Delete
Next i
End With
End Sub

Bonjour Sylvanu.
Merci beaucoup: cela répond parfaitement à ma demande. Excellente journée.
 

cgpa

XLDnaute Occasionnel
Bonjour cgpa, sylvanu,

Une méthode classique dans le fichier joint, elle utilise une colonne auxiliaire :
VB:
Sub suppr_vides()
Application.ScreenUpdating = False
With [Tableau16]
    .Columns(.Columns.Count).EntireColumn.Insert 'insère une colonne auxiliaire
    .Columns(.Columns.Count - 1) = "=1/SIGN(COUNTA(" & .Cells(1).Resize(, .Columns.Count - 2).Address(0, 0) & "))"
    .Columns(.Columns.Count - 1) = .Columns(.Columns.Count - 1).Value 'supprime les formules
    .Sort .Columns(.Columns.Count - 1), Header:=xlYes 'tri pour accélérer, place les valeurs d'erreur en bas
    On Error Resume Next 'si aucune SpecialCell
    Intersect(.Columns(.Columns.Count - 1).SpecialCells(xlCellTypeConstants, 16).EntireRow, .Cells).Delete xlUp
    .Columns(.Columns.Count - 1).EntireColumn.Delete 'suppression de la colonne auxiliaire
End With
End Sub
La macro est très rapide sur un grand tableau car cellui-ci est trié avant suppression des lignes.

A+

Bonjour Job75.
Merci beaucoup: cela répond également parfaitement à ma demande. Tous les chemins mènent à Rome! Excellente journée.
 

Discussions similaires

Statistiques des forums

Discussions
311 725
Messages
2 081 943
Membres
101 849
dernier inscrit
florentMIG