XL 2016 Suppression Ligne

[guellila]

Bonjour
j'ai un tableau Excel avec des données et je cherche une macro pour supprimer les ligne ou il y a une cellules qui contient la valeur 0 ainsi de supprimer aussi la ligne qui la précède et la ligne qui la suive (voir tableau ci dessous )

merci d'avance

 

[sylvanu]

Bonsoir Guellila,
Un petit fichier test eût été plus utile qu'une image.
Un essai en PJ avec :
Sub Supprime()
Application.ScreenUpdating = False
DL = Range("A65500").End(xlUp).Row
For L = DL To 2 Step -1
If Application.CountIf(Range(Cells(L, "A"), Cells(L, "E")), 0) > 0 Then
Rows(L + 1).Delete: Rows(L).Delete: Rows(L - 1).Delete
DL = DL - 1
End If
Next L
End Sub

 

[job75]

Bonsoir guellila, sylvanu,

La feuille active étant celle à traiter exécutez cette macro :

Sub SupprimerLignesZeros()
Application.ScreenUpdating = False
With ActiveSheet.UsedRange.Offset(1)
    With .Columns(.Columns.Count + 1) 'colonne auxiliaire
        .FormulaR1C1 = "=1/SIGN(COUNTIF(R[-1]C1:R[-1]C[-1],0)+COUNTIF(RC1:RC[-1],0)+COUNTIF(R[1]C1:R[1]C[-1],0))"
        .Value = .Value 'supprime les formules
        .EntireRow.Sort .Cells, xlDescending, Header:=xlNo 'tri pour regrouper et placer les 1 en bas
        On Error Resume Next 'si aucune SpecialCell
        .SpecialCells(xlCellTypeConstants, 1).EntireRow.Delete 'supprime les lignes avec 1
        .EntireColumn.Delete 'supprime la colonne auxiliaire
    End With
    With .Parent.UsedRange: End With 'actualise les barres de défilement
End With
End Sub

Elle est très rapide car les lignes à supprimer sont regroupées par le tri et supprimées en bloc.

Les formats sont conservés.

A+

 

[job75]

Pour tester j'ai créé un tableau de 5 colonnes et 100 000 lignes (2,3 Mo).

Avec 25 000 lignes contenant un zéro et 75 000 lignes à supprimer.

Chez moi la macro s'exécute en 0,8 seconde.

 

[guellila]

Bonsoir job75, sylvanu,
merci a vous deux les deux macro marchent a la perfection merci encore une fois pour votre support

salutations