优化在VBA中删除隐藏行的性能 [英] Optimize performance of Removing Hidden Rows in VBA

问题描述

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

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

代码来自此处:在自动过滤后删除隐藏/不可见的行Excel VBA

此外，我阅读了以下主题:加速代码删除工作表上的隐藏行

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

情况:我对包含12列的表应用了5种不同的过滤器，因此在该过程之后，很多行被过滤掉(隐藏).当我尝试删除它们时，上面的代码花费很长时间.就我而言，我不知道Excel是否仍在工作，所以我不得不强行退出.这导致了以下问题:

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?

推荐答案

我认为您不需要涉及其他工作表.只需复制现有 Range.CurrentRegion属性下方的行，然后然后删除过滤器并删除原始数据.

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

通过在代码审查(Excel)上发布，您可能还会在此主题上获得一些很好的重点帮助.

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

这篇关于优化在VBA中删除隐藏行的性能的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！