XL 2016 Supprimer ligne si chaque valeur dans les colonnes =0

AGDALT · 24 Août 2020

Bonjour,

Je souhaite dans mon fichier supprimer les lignes où j'ai la valeur 0 dans chacune des 12 colonnes (1 colonne= 1mois).
Il se peut qu'un mois ait pour valeur 10 et un autre mois pour valeur -10, dans ce cas, je souhaite que la ligne reste et ne soit pas supprimée. Il ne faut donc pas faire de somme des 12 mois.
De plus, les 12 mois sont entre la colonne C et N mais si ces cellules font chacune zero, je voudrais supprimer la ligne entière (de colonne A à Z).

J'ai réussi à faire une macro qui fait le job mais l'éxecution est vraiment trop longue (10min). Il y a environ 6000 lignes et il en reste 1800 à la fin.

Auriez-vous une astuce pour raccourcir le temps d'éxecution?

Voila ce que j'ai écrit :

Sub Useless_Lines()

Application.ScreenUpdating = False
Dim iCalcul As Integer
iCalcul = Application.Calculation
Application.Calculation = False

'DELETE LINES WITH ZERO
Sheets("Forecast BI").Activate
Dim NbLine As Integer
Dim i As Integer
NbLine = Range("T" & Rows.Count).End(xlUp).Row

For i = NbLine To 1 Step -1
If Cells(i, 3) = 0 And Cells(i, 4) = 0 And Cells(i, 5) = 0 And Cells(i, 6) = 0 And Cells(i, 7) = 0 And Cells(i, 8) = 0 And Cells(i, 9) = 0 And Cells(i, 10) = 0 And Cells(i, 11) = 0 And Cells(i, 12) = 0 And Cells(i, 13) = 0 And Cells(i, 14) = 0 Then Rows(i).Delete
Next i

Application.Calculation = iCalcul
Application.ScreenUpdating = True

Merci d'avance,

Efgé · 24 Août 2020

Bonjour à tous
Une proposition par tableau, qui vérifie les valeurs et non leur somme:

VB:

Sub test()
Dim Plg As Range
Dim i&, LstRow&, J&, Col&, Col2&
Dim TMp As Variant
Dim Flg As Boolean

With Sheets("Forecast BI")
    LstRow = .Cells(.Rows.Count, 1).End(3).Row
    Set Plg = .Range("A2:T" & LstRow)
End With

TMp = Plg

For i = LBound(TMp, 1) To UBound(TMp, 1)
    Flg = False
    For Col = 3 To 13
        If TMp(i, Col) <> 0 Then Flg = True
    Next Col
    If Flg Then
    J = J + 1
        For Col2 = LBound(TMp, 2) To UBound(TMp, 2)
            TMp(J, Col2) = TMp(i, Col2)
        Next Col2
    End If
Next i

Application.ScreenUpdating = False
    Plg.ClearContents
    Plg.Resize(J, UBound(TMp, 2)) = TMp
Application.ScreenUpdating =...

Efgé · 24 Août 2020

Re à tous
On peux réduire le temps de traitement en remplaçant

VB:

 For Col = 3 To 13
        If TMp(i, Col) <> 0 Then Flg = True
 Next Col

par

Code:

For Col = 3 To 13
 If TMp(i, Col) <> 0 Then
    Flg = True
    Exit For
 End If
Next Col

Ce qui peut gagner quelques dixièmes de secondes; mais est-ce bien utile ?

Cordialement

mapomme · 25 Août 2020

Bonjour à tous ,

Une autre méthode assez rapide et sans tableau.

VB:

Sub Supprligne0()
Dim derLig&, macol&
   Application.ScreenUpdating = False
   With Sheets("Forecast BI")
      If .FilterMode Then .ShowAllData
      derLig = .Cells(.Rows.Count, "t").End(xlUp).Row
      macol = .UsedRange.Column + .UsedRange.Columns.Count
      On Error GoTo ERREUR
      .Columns(macol).Resize(derLig).Formula = "=IF(SUMPRODUCT(ABS(c1:n1))=0,NA(),ROW())"
      .Columns(macol).Resize(derLig).Value = .Columns(macol).Resize(derLig).Value
      .Range(.Cells(1, "a"), .Cells(derLig, macol)).Sort key1:=.Cells(1, macol), order1:=xlAscending, Header:=xlNo
      On Error Resume Next
      .Columns(macol).Resize(derLig).SpecialCells(xlCellTypeConstants, 16).EntireRow.Delete
      On Error GoTo ERREUR
      .Columns(macol).Delete
      MsgBox "sur " & Format(derLig, "#,##0") & " lignes, " & vbLf & _
      Format((derLig - Application.CountA(Columns("t:t"))), "#,##0") & " ont été supprimées."
      Exit Sub
ERREUR:
      MsgBox "Une erreur s'est produite : " & Err.Description
      .Columns(macol).Delete
   End With
End Sub

XL 2016 Supprimer ligne si chaque valeur dans les colonnes =0

AGDALT

XLDnaute Nouveau

Efgé

Efgé

XLDnaute Barbatruc

mapomme

XLDnaute Barbatruc

Pièces jointes

Discussions similaires