Löschen per VBA dauert lange

Forumthread: Löschen per VBA dauert lange

17.03.2017 11:29:20

r2d2

Hallo,
ich möchte Datensätze per VBA löschen. Hier mein Code:

Sub test
For i = 90000 To 2 Step -1
If Range("A" & i) = "TEST" Then Rows(i).Delete
Next i
End Sub

Leider läuft der Code ziemlich lange...
Kann man das irgendwie beschleunigen (die automatische Berechnung und ScreenUpdating habe ich schon deaktiviert)?
Danke und Gruß, r2d2

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Entweder über den....

17.03.2017 12:14:48

Case
erst sammeln, dann löschen

17.03.2017 12:15:53

Rudi
AW: erst sammeln, dann löschen

17.03.2017 12:18:29

r2d2

Entweder über den....

17.03.2017 12:14:48

Case

Hallo :-)
... "Autofilter", oder über "RemoveDuplicates": ;-)

Option Explicit
Sub Main()
Dim lngCalc As Long
On Error GoTo Fin
With Application
.ScreenUpdating = False
.EnableEvents = False
lngCalc = .Calculation
.Calculation = xlCalculationManual
.DisplayAlerts = False
End With
Columns("A:A").AutoFilter Field:=1, Criteria1:="TEST"
Range("A2:A" & Rows.Count).SpecialCells(xlCellTypeVisible).EntireRow.Delete
Columns("A:A").AutoFilter
Fin:
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = lngCalc
.DisplayAlerts = True
End With
If Err.Number  0 Then MsgBox "Fehler: " & _
Err.Number & " " & Err.Description
End Sub
Sub Main_1()
Dim lngCalc As Long
On Error GoTo Fin
With Application
.ScreenUpdating = False
.EnableEvents = False
lngCalc = .Calculation
.Calculation = xlCalculationManual
.DisplayAlerts = False
End With
With ActiveSheet.UsedRange
With .Columns(.Columns.Count + 1)
.FormulaR1C1 = "=IF(RC1=""TEST"",""H2SO4"",Row())"
.Cells(1, 1).Value = "H2SO4"
.EntireRow.RemoveDuplicates .Column, xlNo
.ClearContents
End With
End With
Fin:
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = lngCalc
.DisplayAlerts = True
End With
If Err.Number  0 Then MsgBox "Fehler: " & _
Err.Number & " " & Err.Description
End Sub

Servus
Case

erst sammeln, dann löschen

17.03.2017 12:15:53

Rudi

Hallo,

Sub test()
Dim r As Range
For i = 2 To 90000
If Cells(i, 1) = "TEST" Then
If r Is Nothing Then
Set r = Cells(i, 1)
Else
Set r = Union(r, Cells(i, 1))
End If
End If
Next i
If Not r Is Nothing Then r.EntireRow.Delete
End Sub

Gruß
Rudi

AW: erst sammeln, dann löschen

17.03.2017 12:18:29

r2d2

Super, danke euch beiden :-)

Beliebteste Forumthreads (12 Monate)

Forumthread: Löschen per VBA dauert lange

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread