Supprimer les lignes contenants 3 fois la valeur 0 dans des colonnes contigues

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

christ91

XLDnaute Nouveau
Bonjour,

J'ai un tableau pour lequel je souhaiterai supprimer les lignes qui contiennent dans 3 colonnes contiguës la valeur 0

exemple dans le fichier joint je voudrais supprimer les lignes 3 et 6

bien évidement, je n'ai jamais le même nombre de ligne dans mon tableau.

Quelqu'un aurait-il une idée de macro pour cela ?

Merci
Christophe
 

Pièces jointes

Re : Supprimer les lignes contenants 3 fois la valeur 0 dans des colonnes contigues

bonjour

mets le code suivant dans un module, cela devrait le faire

Sub SupprLignes()
Dim lig, col, i, j, nb

lig = Range("A" & Rows.Count).End(xlUp).Row
col = Range("A1").End(xlToRight).Column
nb = 0

For i = lig To 1 Step -1
For j = 2 To col
Cells(i, j).Select
If Cells(i, j) = 0 Then
nb = nb + 1
If nb > 2 Then Rows(i).EntireRow.Delete
Else: nb = 0
End If
Next j
nb = 0
Next i

End Sub
 
Re : Supprimer les lignes contenants 3 fois la valeur 0 dans des colonnes contigues

Bonjour,

Solution possible parmi d'autres:
Code:
Sub suppr()
    Dim r As Range, c As Range, plg As Range
    Dim i As Byte
    With ActiveSheet.Range("A1").CurrentRegion
            For Each r In .Rows
                i = 0
                For Each c In r.Cells
                    i = Array(0, i + 1)(-1 * (c = 0))
                    If i = 3 Then
                        If plg Is Nothing Then Set plg = r Else Set plg = Union(r, plg)
                        Exit For
                    End If
                Next c
            Next r
        If Not plg Is Nothing Then plg.Delete xlShiftUp
    End With
End Sub

A+

[Edit] hello Mutzik🙂
 
Dernière modification par un modérateur:
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Retour