XL 2010 Suppression de lignes si toutes les cellules de cette même ligne est = 0

Aurélie13008 · 19 Octobre 2021

Bonjour,

J'explique ma problématique : je dois vérifier pour chaque ligne si toutes les colonnes sont à 0 (dans mon fichier joint colonne de I à Q). Si elles sont bien à 0 je veux supprimer les lignes. Je voudrais pouvoir faire cela en automatique dès que ma requête sort.

Je souhaiterais savoir comment adapter un code VBA que j'ai vu sur votre forum pour vérifier et l'adapter à ma situation. c'est-à-dire qu'au lieu que le déclencheur soit 1 seule cellule à 0, je veux que ce soit les cellules de I à Q. J'espère que c'est assez claire, histoire de pas faire perdre du temps...

Merci bcp

Ci-dessous le code trouver sur votre forum

Option Explicit

Sub Elimine_0()
Dim Lig%
Application.ScreenUpdating = 0

For Lig = [C65536].End(xlUp).Row To 1 Step -1
If Range("C" & Lig).Value = 0 Then Rows(Lig).Delete
Next
End Sub

Efgé · 19 Octobre 2021

Re
P.S :
Modifier

VB:

For Lig = [C65536].End(xlUp).Row To 14 Step -1

par

Code:

For Lig = Cells(Rows.Count, 1).End(xlUp).Row To 14 Step -1

Cordialement

Efgé · 19 Octobre 2021

Bonjour Aurélie13008 et bienvenue sur le forum

une proposition:

VB:

Option Explicit

Sub Elimine_0_2()
Dim Lig&, Col&, Flag As Boolean

Application.ScreenUpdating = 0
    For Lig = [C65536].End(xlUp).Row To 14 Step -1
        For Col = 9 To 17
            If Cells(Lig, Col) <> 0 Then
                Flag = True
                Exit For
            End If
        Next Col
        If Not Flag Then Rows(Lig).Delete
        Flag = False
    Next Lig
Application.ScreenUpdating = 1
End Sub

P.S La prochaine foi ne laisse pas de logo d'entreprise dans tes fichiers exemples. Les exemples doivent être anonymes (pas de noms, de numéro de téléphone, de logos etc...)
Cordialement

Efgé · 19 Octobre 2021

Re
P.S :
Modifier

VB:

For Lig = [C65536].End(xlUp).Row To 14 Step -1

par

Code:

For Lig = Cells(Rows.Count, 1).End(xlUp).Row To 14 Step -1

Cordialement

Aurélie13008 · 19 Octobre 2021

Efgé à dit:
Bonjour Aurélie13008 et bienvenue sur le forum

une proposition:

VB:

Option Explicit Sub Elimine_0_2() Dim Lig&, Col&, Flag As Boolean Application.ScreenUpdating = 0 For Lig = [C65536].End(xlUp).Row To 14 Step -1 For Col = 9 To 17 If Cells(Lig, Col) <> 0 Then Flag = True Exit For End If Next Col If Not Flag Then Rows(Lig).Delete Flag = False Next Lig Application.ScreenUpdating = 1 End Sub

P.S La prochaine foi ne laisse pas de logo d'entreprise dans tes fichiers exemples. Les exemples doivent être anonymes (pas de noms, de numéro de téléphone, de logos etc...)
Cordialement

Oui, j'y ai pensé mais c'était trop tard.. Merci

Vous êtes au top! ça fonctionne j'ai plus qu'à mettre ça dans un bouton.

Merci pour votre réactivité, cela faisait 3 jours que j'étais dessus...
Bonne journée

Efgé · 19 Octobre 2021

Re
Tu peux éditer ton premier message et supprimer les fichiers joints.
Regarde mon second P.S sur une modification de ligne.

Cordialement

Aurélie13008 · 19 Octobre 2021

C'est fait.
J'ai vu votre message
Merci encore

Phil69970 · 19 Octobre 2021

Bonjour @Aurélie13008 ,@Efgé

Je propose cette version
*Je teste la colonne L et Q si 0 alors suppression (pas besoin de la colonne R (A supprimer)

@Phil69970

Efgé · 19 Octobre 2021

Re
Bonjour Phil9970
Attention, une somme peut arriver à 0 sans que l'ensemble des cellules soient ègales à 0.
On ne sait jamais -100+100 = 0

Cordialement

Phil69970 · 19 Octobre 2021

Re

Certes mais dans la liste fournie je n'ai pas vu de montant négatif

Aurélie pourrait nous dire si ton cas pourrait se produire.

@Phil69970

mapomme · 19 Octobre 2021

Surtout pour vous saluer tous , une autre méthode :
Code dans le module de Feuil1:

VB:

Sub Supp()
Dim i&, xrg As Range
   Application.ScreenUpdating = False
   For i = Cells(Rows.Count, "a").End(xlUp).Row To 1 Step -1
      Set xrg = Range(Cells(i, "i"), Cells(i, "q"))
      If Application.CountIf(xrg, "<>0") = 0 Then xrg.EntireRow.Delete
   Next i
End Sub

Aurélie13008 · 19 Octobre 2021

En effet, il peut arrivé que des montants soit négatifs, mais c'est plutôt rare...
Je leur dirais de faire attention. Pour cela il suffit de filtrer pour vérifier, car s'il y a un montant négatif dans le tableau ça sera toujours dans la même colonne.

Mais merci d'y avoir pensé et merci pour la deuxième solution que je garde sous le coude!

job75 · 19 Octobre 2021

Bonjour à tous,

S'il y a beaucoup de lignes la suppression ligne par ligne prend trop de temps.

Utilisez plutôt une colonne auxiliaire avec formule :

VB:

Sub SupprimerLignesZero()
Application.ScreenUpdating = False
With Range("A1", ActiveSheet.UsedRange)
    .Columns(18).EntireColumn.Insert 'colonne auxiliaire
    .Columns(18).FormulaR1C1 = "=1/(SUMPRODUCT(ISNUMBER(RC9:RC17)*(RC9:RC17=0))=9)"
    On Error Resume Next 'si aucune SpecialCell
    .Columns(18).SpecialCells(xlCellTypeFormulas, 1).EntireRow.Delete 'supprime les résultats numériques (1)
    .Columns(18).EntireColumn.Delete 'supprime la colonne auxiliaire
End With
End Sub

Si vous voulez voir les formules en colonne auxiliaire R neutralisez la ligne qui supprime cette colonne.

A+

Aurélie13008 · 19 Octobre 2021

Je vais regarder cela.
Merci

job75 · 19 Octobre 2021

Mon code précédent est insuffisant.

Pour aller vite il faut ajouter un tri, voyez ce fichier (2).

Evidemment cela crée un petit problème avec les bordures car elles ne suivent pas le tri :

VB:

Sub SupprimerLignesZero()
Application.ScreenUpdating = False
With Range("A1", ActiveSheet.UsedRange)
    .Range("14:" & .Rows.Count).Borders.LineStyle = xlNone 'efface les bordures
    .Columns(18).EntireColumn.Insert 'colonne auxiliaire
    .Columns(18).FormulaR1C1 = "=1/(SUMPRODUCT(ISNUMBER(RC9:RC17)*(RC9:RC17=0))=9)"
    .Columns(18) = .Columns(18).Value 'supprime les formules
    .EntireRow.Sort .Columns(18), xlDescending, Header:=xlNo 'tri décroissant pour placer les 1 en bas
    On Error Resume Next 'si aucune SpecialCell
    .Columns(18).SpecialCells(xlCellTypeConstants, 1).EntireRow.Delete 'supprime les résultats numériques (1)
    .Columns(18).EntireColumn.Delete 'supprime la colonne auxiliaire
End With
'---bordures---
With [A13].CurrentRegion.Resize(, 17)
    .Borders.Weight = xlMedium
    If .Cells(.Rows.Count + 2, 9) <> "" Then .Cells(.Rows.Count + 2, 9).Resize(, 9).Borders.Weight = xlMedium
End With
End Sub

Aurélie13008 · 19 Octobre 2021

Alors j'essaie d'adapter votre code à mon fichier car vous ne l'avez pas en entier.
sauf que bah du coup, j'ai un bug!

Option Explicit

Sub SupprimerLignesZero()
Application.ScreenUpdating = False
With Range("A1", ActiveSheet.UsedRange)
.Range("14:" & .Rows.Count).Borders.LineStyle = xlNone 'efface les bordures
.Columns(25).EntireColumn.Insert 'colonne auxiliaire
.Columns(25).FormulaR1C1 = "=1/(SUMPRODUCT(ISNUMBER(RC16:RC24)*(RC16:RC24=0))=9)"
.Columns(25) = .Columns(25).Value 'supprime les formules
.EntireRow.Sort .Columns(25), xlDescending, Header:=xlNo 'tri décroissant pour placer les 1 en bas
On Error Resume Next 'si aucune SpecialCell
.Columns(25).SpecialCells(xlCellTypeConstants, 1).EntireRow.Delete 'supprime les résultats numériques (1)
.Columns(25).EntireColumn.Delete 'supprime la colonne auxiliaire
End With
'---bordures---
With [A13].CurrentRegion.Resize(, 24)
.Borders.Weight = xlMedium
If .Cells(.Rows.Count + 2, 9) <> "" Then .Cells(.Rows.Count + 2, 9).Resize(, 9).Borders.Weight = xlMedium
End With
End Sub

Celle qui est souligné m'apparaît en jaune... mes colonnes vont de A à Y et les montants de P à Y

XL 2010 Suppression de lignes si toutes les cellules de cette même ligne est = 0

Aurélie13008

XLDnaute Nouveau

Pièces jointes

Efgé

Efgé

XLDnaute Barbatruc

Efgé

XLDnaute Barbatruc

Aurélie13008

XLDnaute Nouveau

Efgé

XLDnaute Barbatruc

Aurélie13008

XLDnaute Nouveau

Phil69970

XLDnaute Barbatruc

Pièces jointes

Efgé

XLDnaute Barbatruc

Phil69970

XLDnaute Barbatruc

mapomme

XLDnaute Barbatruc

Pièces jointes

Aurélie13008

XLDnaute Nouveau

job75

XLDnaute Barbatruc

Pièces jointes

Aurélie13008

XLDnaute Nouveau

job75

XLDnaute Barbatruc

Pièces jointes

Aurélie13008

XLDnaute Nouveau

Discussions similaires