Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1544to1548
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Löschen per VBA dauert lange

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
Anzeige
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

Anzeige
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 :-)

124 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige