VBA macro to delete rows quickly

问题:

I have several really large excel data files and I need to go through them all and delete all rows where the value of the cell in column T is 1. Right now my code looks like:

Sub test()
    Dim cell As Range

    For Each cell In Worksheets("Sheet1").Range("T5", "T900000")
        If cell.Value = 1 Then
            cell.EntireRow.Delete
        End If
    Next cell
End Sub

It seems to be working, but takes forever to run and I'm going to have to do this a bunch of times. Is there a better way of doing this, or some way to optimize what I already have to make it run faster?

回答1:

This doesn't work as you think... When you delete rows as you iterate through them, you end up skipping rows. Example: imagine your rows have the numbers 1...10 in column A. You look at the first row and decide to delete it. Now you look at the second row. It has the number 3! You never looked at row 2!!

Better method would be to filter the spreadsheet on your criteria for column T, copy it, paste it I to a new worksheet (with formatting etc).

You can turn on macro recording and do this manually; then you will have the exact VBA code. I am sure that will be much faster.

Even if you don't do that, if you want to do a for each where you delete things, reverse the order (start at the end and work backwards)

回答2:

If you wanted to use a loop, the following should not skip items. I think that @Floris Filter method might be quicker though.

Sub Main()
    Dim Row As Long
    Dim Sheet As Worksheet
    Row = 5
    Set Sheet = Worksheets("Sheet1")
    Application.ScreenUpdating = False
    Do
        If Sheet.Cells(Row, 20).Value = 1 Then
            Sheet.Rows(Row).Delete xlShiftUp
        Else
            Row = Row + 1
        End If
    Loop While Row <= 900000
    Application.ScreenUpdating = True
End Sub

Update I've toggled Application.ScreenUpdating around the loop, which usually speeds stuff like this up a lot!

回答3:

In case you manage your data like a database and want to delete specific rows out of it and it is possible to filter them, there is a trick to speed up your delete-process. This is very fast in contrast to the simple loop-process:

I compare the times for different examples (with 4806 rows).

• Standard loop-deletion: 2:25
• Range-deletion: 0:20
• Filter-deletion: 0:01

Example: I have data in 'Tabelle5' and want to delete specific rows. The data starts at row 6. Every row in column 1, which begin with "OLD#" should be deleted.

1) Here the standard solution (longest time):

Dim i As Integer, counter As Integer
Dim strToRemove As String, strToRemoveRange As String
strToRemove = "OLD#"
strToRemoveRange = ""
counter = 0

With Tabelle5
    For i = .UsedRange.Rows.Count To 6 Step -1
        If Mid(.Cells(i, 1).value, 1, 4) = strToRemove Then
            .Rows(i).Delete Shift:=xlUp
        End If
    Next i
End With

2) Here the Range solution (middle time):

Dim i As Integer, counter As Integer
Dim strToRemove As String, strToRemoveRange As String
strToRemove = "OLD#"
strToRemoveRange = ""
counter = 0

With Tabelle5
    For i = .UsedRange.Rows.Count To 6 Step -1
        If Mid(.Cells(i, 1).value, 1, 4) = strToRemove Then
            If strToRemoveRange = "" Then
                strToRemoveRange = CStr(i) & ":" & CStr(i)
            Else
                strToRemoveRange = strToRemoveRange & "," & CStr(i) & ":" & CStr(i)
            End If
            counter = counter + 1
        End If
        If counter Mod 25 = 0 Then
            If counter > 0 Then
                .Range(strToRemoveRange).Delete Shift:=xlUp
                strToRemoveRange = ""
                counter = 0
            End If
        End If
    Next i
    If Len(strToRemoveRange) > 0 Then
        '.Range(strToRemoveRange).Delete Shift:=xlUp
    End If
End With

3) Filter solution (shortest time):

Dim i As Integer, counter As Integer
Dim strToRemove As String, strToRemoveRange As String
strToRemove = "OLD#"
strToRemoveRange = ""
counter = 0

With Tabelle5
    For i = .UsedRange.Rows.Count To 6 Step -1
        If Mid(.Cells(i, 1).value, 1, 4) = strToRemove Then
            .Cells(i, 1).Interior.Color = RGB(0, 255, 0)
            counter = counter + 1
        End If
    Next i
    If counter > 0 Then
        .Rows("5:5").AutoFilter
        .AutoFilter.Sort.SortFields.Clear
        .AutoFilter.Sort.SortFields.Add( _
            Range("A5"), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(0, 255, 0)
        .AutoFilter.Sort.Header = xlYes
        .AutoFilter.Sort.MatchCase = False
        .AutoFilter.Sort.Orientation = xlTopToBottom
        .AutoFilter.Sort.SortMethod = xlPinYin
        .AutoFilter.Sort.Apply
        .Rows("6:" & CStr(counter + 5)).Delete Shift:=xlUp
        .Rows("5:5").AutoFilter
    End If
End With

Here the green lines will be ordered to the top and a range of the green hits will be deleted as a whole. That's the fastest way I know! :-)

I hope it will help someone!

Best regards Tom

回答4:

The quickest method I have found is to clear row data (.clear) and then sort. For example, I want to get rid of page breaks that show as " ========= "

I=20
Do While i <= lRow3
    If Left(Trim(ws3.Cells(i, 1)), 1) = "=" Then
        ws3.Range(Rows(i - 7), Rows(i + 2)).Clear
        'i = i - 7
        'lRow3 = lRow3 - 10
    End If
    i = i + 1
Loop

Now sort then do an xlUp last row (ws3.Range("A1000000").End(xlUp).Row) etc.

Deleting the rows (in one of my files which is 220,000 rows approx.) takes 3 minutes. Clearing the contents takes under 10 seconds.

The problem then becomes how to 'remove' the empty rows if you need to move data from below the rows to one above before this is done. :)

Cheers, BJ