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

Aurélie13008

XLDnaute Nouveau
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
 

Pièces jointes

  • Test 1.xls
    53.5 KB · Affichages: 6

Efgé

XLDnaute Barbatruc
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
 
Dernière édition:

Aurélie13008

XLDnaute Nouveau
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
 

mapomme

XLDnaute Barbatruc
Supporter XLD
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
 

Pièces jointes

  • Aurélie13008- Suppr ligne si condition- v1.xls
    57.5 KB · Affichages: 6

Aurélie13008

XLDnaute Nouveau
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

XLDnaute Barbatruc
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+
 

Pièces jointes

  • Test(1).xls
    60.5 KB · Affichages: 4

job75

XLDnaute Barbatruc
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
 

Pièces jointes

  • Test(2).xls
    71.5 KB · Affichages: 3

Aurélie13008

XLDnaute Nouveau
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
 

Discussions similaires

Statistiques des forums

Discussions
311 720
Messages
2 081 898
Membres
101 834
dernier inscrit
Jeremy06510