优化 VBA 中删除隐藏行的性能

Question

在将自动过滤器应用于 VBA 中的大工作表（大意味着大约 30,000 行）后，我正在使用以下代码删除隐藏/过滤的行：

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

代码来自这里：Delete Hidden/Invisible Rows after Autofilter Excel VBA

此外，我阅读了这个帖子：Speeding Up Code that Removes Hidden Rows on a Sheet

情况：我对包含 12 列的表应用了 5 种不同的过滤器，因此在处理后很多行被过滤掉（隐藏）。当我尝试删除这些时，上面的代码需要很长时间。就我而言，我不知道 Excel 是否仍在工作，所以我不得不强制退出。这就引出了以下问题：

除了遍历所有隐藏的行并删除它们之外，还有其他方法吗？

我想到的一个想法是仅将剩余的未过滤（即非隐藏）内容复制到新工作表，然后删除包含完整信息的旧工作表。如果可以，怎么做？

Answer 1

我认为您不需要涉及另一个工作表。只需复制现有Range.CurrentRegion property 下方的行，然后移除过滤器并删除原始数据。

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

您还可以通过在Code Review (Excel) 上发帖获得有关此主题的一些好的、集中的帮助。

Answer 2

您可以使用以下函数显着提高性能：

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

我在一个应用了 2 个过滤器的文件上对其进行了测试

函数改编自this suggestion中的代码