Optimize performance of Removing Hidden Rows in VBA

问题

I am using the following code to remove hidden/filtered lines after applying autofilters to a big sheet in VBA (big means roughly 30,000 rows):

Sub RemoveHiddenRows()
Dim oRow As Range, rng As Range
Dim myRows As Range
With Sheets("Sheet3")
    Set myRows = Intersect(.Range("A:A").EntireRow, .UsedRange)
    If myRows Is Nothing Then Exit Sub
End With

For Each oRow In myRows.Columns(1).Cells
    If oRow.EntireRow.Hidden Then
        If rng Is Nothing Then
            Set rng = oRow
        Else
            Set rng = Union(rng, oRow)
        End If
    End If
Next
If Not rng Is Nothing Then rng.EntireRow.Delete
End Sub

The code comes from here: Delete Hidden/Invisible Rows after Autofilter Excel VBA

Moreover I read this thread: Speeding Up Code that Removes Hidden Rows on a Sheet

The situation: I have applied 5 different filters to a table consisting of 12 columns, therefore a lot of rows are filtered out (hidden) after the process. When I try to delete those, the code above takes a very long time. In my case I don't know if Excel was still working, so I had to force an exit. That leads to the following question:

Is there any other way than looping through all the hidden rows and deleting them?

An idea which came to my mind was to copy only the remaining unfiltered (that is non-hidden) content to a new sheet and afterwards delete the old sheet, which contains the full information. If so, how can that be done?

回答1:

I don't think you need to involve another worksheet. Simply copy the rows below the existing Range.CurrentRegion property and then remove the filter and delete the original data.

Sub RemoveHiddenRows()

    With Sheets("Sheet10")
        With .Cells(1, 1).CurrentRegion
            With .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count)
                If CBool(Application.Subtotal(103, .Columns(1))) Then
                    .Cells.Copy Destination:=.Cells(.Rows.Count + 1, 1)
                End If
                .AutoFilter
                .Cells(1, 1).Resize(.Rows.Count, 1).EntireRow.Delete
            End With
        End With
    End With

End Sub

You may also receive some good, focused help on this subject by posting on Code Review (Excel).

回答2:

You can improve performance significantly with a function like this:

Option Explicit

Public Sub deleteHiddenRows(ByRef ws As Worksheet)

    Dim rngData As Range, rngVisible As Range, rngHidden As Range

    With ws
        Set rngData = .UsedRange
        With rngData
            Set rngVisible = .SpecialCells(xlCellTypeVisible)
            Set rngHidden = .Columns(1)
        End With
    End With

    If Not (rngVisible Is Nothing) Then

        ws.AutoFilterMode = False

        ' invert hidden / visible
        rngHidden.Rows.Hidden = False
        rngVisible.Rows.Hidden = True

        ' delete hidden and show visible
        rngData.SpecialCells(xlCellTypeVisible).Delete
        rngVisible.Rows.Hidden = False

    End If
End Sub

I tested it on a file with 2 filters applied to it

The function was adapted from the code in this suggestion

来源：https://stackoverflow.com/questions/30425953/optimize-performance-of-removing-hidden-rows-in-vba

标签

performance

vba

loops

excel

filter