PDA

Vollständige Version anzeigen : Langsamer Code, der aber sehr kurz ist


Irie
14.01.2014, 21:10
Kann mir jmd einen effizienteren Code daraus basteln? Der angegebene braucht Stunden zum Durchlaufen...

Sub HTfinden()
Dim i As Long

For i = 2 To 85349
If Cells(i, 4) = 6 Or Cells(i, 4) = 7 Or Cells(i, 5) = 0 Then
Cells(i, 1).EntireRow.Delete
i = i - 1
End If

Next i

End Sub

chris-kaiser
14.01.2014, 21:18
Hi,

mehr Code aber 10.000 mal schneller

Sub HTfinden()
Dim i As Long, rngBig_One As Range

For i = 2 To Cells(Rows.Count, 4).End(xlUp).Row
If Cells(i, 4) = 6 Or Cells(i, 4) = 7 Or Cells(i, 5) = 0 Then
If rngBig_One Is Nothing Then
Set rngBig_One = Rows(i)
Else
Set rngBig_One = Union(rngBig_One, Rows(i))
End If
End If

Next i
If Not rngBig_One Is Nothing Then rngBig_One.Delete
End Sub

Irie
14.01.2014, 21:25
Auf die Idee, erst die Spalten zu sammeln und dann alle zu löschen, hätte ich auch mal kommen können ;) Vielen Dank!

Lustig wie dein Code das Problem in ca. 10 Sek, gelöst hat und meiner nach rund 3 Stunden Laufzeit gerade mal 30% hatte... krass!

ebs17
14.01.2014, 22:26
Wenn Du eine schöne Liste hast, probiere dann mal ...
Sub DeleteLines()
' Verweis auf Microsoft ActiveX Data Objects 2.8 Library

Dim sQuery As String
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset

Set rs = New ADODB.Recordset
Set cn = New ADODB.Connection
cn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Extended Properties='Excel 12.0 Xml;HDR=no';" & _
"Data Source=" & ThisWorkbook.FullName
cn.Open

' Seitenbegrenzung Spalte H anpassen
sQuery = "SELECT * FROM [Tabelle3$A2:H]" & _
" WHERE F4 <> 6 OR F4 <> 7 OR F5 <> 0"
With rs
.ActiveConnection = cn
.CursorType = adOpenKeyset
.CursorLocation = adUseClient
.Source = sQuery
.Open
End With
With Worksheets("Tabelle3")
.UsedRange.Clear
.Cells(2, 1).CopyFromRecordset rs
End With
rs.Close
cn.Close
Set rs = Nothing
Set cn = Nothing
End Sub

HS(V)
14.01.2014, 23:27
Oder mit Filtern.

With Sheets(1).Range("D1:E85349")
.AutoFilter 1, 6, xlOr, 7
Sheets(1).AutoFilter.Range.Offset(1).SpecialCells(12).EntireRow.Delete
.AutoFilter
.AutoFilter 2, 0
Sheets(1).AutoFilter.Range.Offset(1).SpecialCells(12).EntireRow.Delete
.AutoFilter
End With

Irie
20.01.2014, 00:28
Was ihr alles kennt! Danke für die super Ratschläge.