vba - 在 excel 中有效地复制可见/过滤的行

Question

我正在处理一些非常大的数据集(每张有 65K+ 行和很多列的各种工作表)。我正在尝试编写一些代码以尽快将过滤后的数据从一张纸复制到一张新的空白纸，但到目前为止还没有取得太大的成功。

我可以通过请求包含其余代码，但它所做的只是计算源和目标范围(srcRange 和 destRange)。计算这些所需的时间可以忽略不计。绝大多数时间都花在这条线上(准确地说是 4 分 50 秒):

srcRange.Rows.SpecialCells(xlCellTypeVisible).Copy Destination:=destRange

另外我试过这个:

destRange.Value = srcRange.Rows.SpecialCells(xlCellTypeVisible).Value

但是当有过滤器时它不能正常工作。

Function FastCopy(srcSheet As String, srcCol As String, destSheet As String, destCol As String)

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    Dim srcRange As Range
    Dim destRange As Range

    Set srcRange = GetColumnRangeByHeaderName(srcSheet, srcCol, -1)
    Set destRange = GetColumnRangeByHeaderName(destSheet, destCol, srcRange.Rows.Count)


    'destRange.Value = srcRange.Rows.SpecialCells(xlCellTypeVisible).Value

    srcRange.Rows.SpecialCells(xlCellTypeVisible).Copy Destination:=destRange

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationManual
End Function

这是一台运行 excel 2010 的具有 2GB RAM 的慢速双核机器。速度更快的机器上的结果显然会有所不同。

Answer 1

尝试这样的事情来处理过滤范围。你在正确的轨道上，.Copy方法很昂贵，并且简单地从一个范围写入值应该更快，但是正如您所观察到的，当过滤范围时这不起作用。过滤范围时，需要迭代 .Areas在范围内的 .SpecialCells :

Sub Test()
Dim rng As Range
Dim subRng As Range
Dim destRng As Range


Set destRng = Range("A10")

Set rng = Range("A1:B8").SpecialCells(xlCellTypeVisible)

For Each subRng In rng.Areas
    Set destRng = destRng.Resize(subRng.Rows.Count, subRng.Columns.Count)
    destRng.Value = subRng.Value
    Set destRng = destRng.Cells(destRng.Rows.Count, 1).Resize(1, 1).Offset(1, 0)
Next

End Sub

为您的目的而修改，但未经测试:

Function FastCopy(srcSheet As String, srcCol As String, destSheet As String, destCol As String)

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    Dim srcRange As Range
    Dim destRange As Range
    Dim subRng As Range

    Set srcRange = GetColumnRangeByHeaderName(srcSheet, srcCol, -1)
    Set destRange = GetColumnRangeByHeaderName(destSheet, destCol, srcRange.Rows.Count)

    For Each subRng In srcRange.Areas
        Set destRng = destRng.Resize(subRng.Rows.Count, subRng.Columns.Count)
        destRng.Value = subRng.Value
        Set destRng = destRng.Cells(destRng.Rows.Count, 1).Resize(1, 1).Offset(1, 0)
    Next

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationManual
End Function