There are a lot of posts on SO about deleting rows, some good, some not so good.
Two common ones are the Autofilter (which you are using) and building a range with Union (one of which David has linked you to).
For a data set of this size and this many deletions, you will find any method that uses references to Excel worksheet methods (such as AutoFilter, Find, Sort, Union, Formula's etc) slow. Some will be better than others, depending on the exact nature of your data.
There is another method that may work for you. That is to not actually Delete the rows, but to overwrite the data with a modified version.
Note that this only work if you DO NOT have any formulas (either on this sheet or any other) that refer to the data being processed.
I ran this code on a sample data set 500k rows, 20 columns of random numbers 1..32 (so about 25% or rows deleted)
This ran in ~10s
Sub DeleteRows2()
Dim ws As Worksheet
Dim rng As Range
Dim i As Long, j As Long
Dim NewI As Long
Dim dat, NewDat
Dim TestCol As Long
Dim Threashold As Long
Dim LastRow As Long, LastCol As Long
Dim t1 As Single, t2 As Single
t1 = Timer()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
TestCol = 9
Threashold = 8
Set ws = Sheet1
With ws
Set rng = .Range(.Cells(.Rows.Count, 1).End(xlUp), .Cells(1, .Columns.Count).End(xlToLeft))
End With
dat = rng.Value2
ReDim NewDat(1 To UBound(dat, 1), 1 To UBound(dat, 2))
LastRow = UBound(dat, 1)
LastCol = UBound(dat, 2)
NewI = 0
For i = 1 To LastRow
If dat(i, TestCol) > Threashold Then
NewI = NewI + 1
For j = 1 To LastCol
NewDat(NewI, j) = dat(i, j)
Next
End If
Next
rng = NewDat
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
t2 = Timer()
MsgBox "deleted in " & t2 - t1 & "s"
End Sub
与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…