Zeilen löschen mit VBA

Forumthread: Zeilen löschen mit VBA

03.03.2017 07:49:28

r2d2

Hallo,
ich muß, um eine Datei zu verkleinern, alle Datensätze, die keine Werte bzw. in Summe 0 sind löschen. Hierzu verwende ich folgenden Code:

Sub Makro1()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
Range("AJ2").FormulaR1C1 = "=IF(SUM(RC[-30]:RC[-2])=0,""DELETE"","""")"
Range("AJ2").Copy
Range("AJ3:AJ50000").PasteSpecial
Application.CutCopyMode = False
Columns("AJ:AJ").Copy
Columns("AJ:AJ").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False,  _
Transpose:=False
Application.CutCopyMode = False
For i = 50000 To 2 Step -1
If Range("AJ" & i) = "DELETE" Then Rows(i).Delete
Next
Application.EnableEvents = True
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Da es 50.000 Zeilen sind, dauert das ganze recht lange.
Kann man das irgendwie "schneller" machen?
Danke für eure Antworten
Gruß r2d2

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Zeilen löschen mit VBA

03.03.2017 09:30:38

UweD
AW: Zeilen löschen mit VBA

03.03.2017 09:38:34

Daniel

AW: Zeilen löschen mit VBA

03.03.2017 09:30:38

UweD

Hallo

Sub Makro1()
    Dim LR As Long
    
    Application.ScreenUpdating = False
    
    With Sheets("Tabelle1")
        LR = .Cells.SpecialCells(xlCellTypeLastCell).Row 'Letzte Zeile des gesamten Blattes 
        With .Range("AJ2:AJ" & LR)
            .FormulaR1C1 = "=IF(SUM(RC[-30]:RC[-2])=0,""DELETE"","""")"
            .Value = .Value
        End With
        
        If .AutoFilterMode Then .AutoFilterMode = False ' Autofilter ausschalten 
        .Columns(36).AutoFilter Field:=1, Criteria1:="DELETE"
        
        .Rows("2:" & LR).Delete xlUp
        .AutoFilterMode = False

    End With
End Sub

Möge die Macht mit dir sein.
LG UweD

AW: Zeilen löschen mit VBA

03.03.2017 09:38:34

Daniel

Hi
ja, gibt es.
ändere die Formel so ab, dass sie statt dem """" die Zeilennummer ausgibt.
Schreibe außerdem die Formel gleich in alle Zellen, dann musst du sie nicht zusätzlich kopieren:

Range("AJ2:AJ50000").FormulaR1C1 = "=IF(SUM(RC[-30]:RC[-2])=0,""DELETE"",ROW())"

zum löschen hast du dann zwei Möglichkeiten:
a) über die .SpecialCells die Zellen mit Text ("Delete") auswählen und löschen:

Range("AJ2:AJ50000").specialCells(xlcelltypeformulas, 2).entireRow.Delete

hierbei wäre es noch sinnvoll, die Tabelle vor dem Löschen nach Spalte AJ zu sortieren, so dass alle zu löschenden Zeilen einen lückenlos zusammenhängenden Block bilden.
Da ansonsten die Zeilennummer in dieser Spalte steht, wird die Reihenfolge der restlichen Zeilen nicht verändert.
b) die Zeilen mit "Delete" über das Duplikate-Entfernen löschen (in den Zeilen, die stehen bleiben müssen, steht immer ein individueller Wert, daher werden sie nicht gelöscht)
dazu muss noch in die Überschriftenzeile das Delete, in dein Fall reicht es wahrscheinlich aus, die Formel auch in die Überschriftenzeile zu schreiben:

With Range("AJ1:AJ50000")
.FormulaR1C1 = "=IF(SUM(RC[-30]:RC[-2])=0,""DELETE"",ROW())"
.EntrieRow.RemoveDuplicates .Column, Header:=xlno
.ClearContents
End with

Gruß Daniel

Beliebteste Forumthreads (12 Monate)

Forumthread: Zeilen löschen mit VBA

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread