verwijder regels waarvan de som van een aantal cellen 0 is

Status
Niet open voor verdere reacties.

dekrant

Gebruiker
Lid geworden
27 jun 2014
Berichten
20
Goedemorgen,

Ik ben nog een leek op het gebied van VBA, vandaar mijn vraag.
Ik heb een bestandje (zie attachment) waarvan ik de waarden van rij D2 t/m N2 op wil tellen en als daar een waarde 0 uitkomt moet de rij verwijderd worden.
Dit moet dus in een loop komen te staan, want ik wil deze test voor alle rijen doen. Het aantal rijen is variabel en kan oplopen tot 20000 regels.
Ik hoop dat iemand mij kan helpen.

Alvast bedankt
De krant
Bekijk bijlage VOORBEELD OVER.xlsx
 
Laatst bewerkt:
kan met zoiets

Code:
Sub Test()
With ActiveSheet
lr = .Range("A" & Rows.Count).End(xlUp).Row
For x = lr To 2 Step -1
    If Application.Sum(.Range("D" & x, "N" & x)) = 0 Then
        .Range("A" & x, "N" & x).Delete shift:=xlUp
    End If
Next
End With
End Sub

mvg
Leo
 
Dankje, voor je reactie.
Ik heb hem even uitgeprobeerd, maar op een grote lijst (19000 regels) duurt dit te lang.
Ik denk dat ik eerst op alles een controle moet doen en selecteren en dan in één slag verwijderen, of zoiets.....?

Dankje
Groeten
De Krant
 
In het voorbeeldje staan alleen nullen en positieve getallen. Dus de som van heeft geen toegevoegde waarde? Filter op de nullen.

Code:
Sub VenA1()
Application.ScreenUpdating = False
With Sheet1.Cells(1).CurrentRegion
    .AutoFilter
    .AutoFilter 4, "0"
    .AutoFilter 5, "0"
    .AutoFilter 6, "0"
    .AutoFilter 7, "0"
    .AutoFilter 8, "0"
    .AutoFilter 9, "0"
    .AutoFilter 10, "0"
    .AutoFilter 11, "0"
    .AutoFilter 12, "0"
    .AutoFilter 13, "0"
    .AutoFilter 14, "0"
    .Offset(1).SpecialCells(12).EntireRow.Delete
    .AutoFilter
End With
End Sub

Of de som is wel van belang en dan kan je het inladen in een array en de relevante regels weer terug schrijven.

Code:
Sub VenA()
ar = Sheet1.Cells(1).CurrentRegion
ReDim ar1(UBound(ar), 1 To UBound(ar, 2))
    For j = 2 To UBound(ar)
        t = 0
        For jj = 4 To 14
            t = t + ar(j, jj)
        Next jj
        If t <> 0 Then
            For jj = 1 To 14
                ar1(t2, jj) = ar(j, jj)
            Next jj
            t2 = t2 + 1
        End If
    Next j
Sheet1.Cells(1).Offset(1).Resize(UBound(ar1), UBound(ar1, 2)) = ar1
End Sub
 
Code:
Sub tst()
    With Sheets("Sheet1")
    sn = .Cells(1).CurrentRegion.Resize(, 15)
        For i = 2 To UBound(sn)
            For ii = 4 To 14
                sn(i, 15) = sn(i, 15) + sn(i, ii)
            Next
            If sn(i, 15) <> 0 Then sn(i, 15) = ""
        Next
    .Cells(1).Resize(UBound(sn), 15) = sn
    .Range("O2:O" & UBound(sn)).SpecialCells(2).EntireRow.Delete
    End With
End Sub
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan