在Excel中高效地复制可见/过滤的行

我正在处理一些非常大的数据集（各种行，每行65K +多列）。 我正在尝试编写一些代码，以便尽可能快地将过滤的数据从一张纸复制到新的空白纸上，但目前为止还没有取得太大的成功。

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

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

另外我试过这个：

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

但有一个filter时，它不能正常工作。

 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。结果显然会在更快的机器上有所不同。

Answer 1

尝试这样的事情来处理过滤的范围。 你在正确的轨道上.Copy方法是昂贵的，简单地写入从范围到范围的值应该快得多，但是正如你所观察到的，当范围被过滤时这是行不通的。 当范围被过滤时，您需要迭代范围的.SpecialCells的.Areas ：

 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 

修改为您的目的，但未经testing：

 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