Question

我试图找出从大表中过滤数据，过滤数据并将过滤后的数据复制到新工作表的最有效方法。下面是我的代码 - 有效，但需要一分钟才能完成。

我的最终目标是获取模板工作簿（包括我的所有数据）并根据过滤后的数据创建子工作簿。我尝试使用SaveCopyAs创建子工作簿，但最终我丢失了原始数据。所以，我试图将过滤后的数据复制到另一个工作表作为变通方法。

    wsDV.ListObjects("DVTable").Range.AutoFilter Field:=2, Criteria1:=wsMaster.Range("F" & x)
    Application.DisplayAlerts = False
    On Error Resume Next
    wsDV.ListObjects("DVTable").HeaderRowRange.Copy Destination:=wsSalary.Range("C3")
    wsDV.ListObjects("DVTable").DataBodyRange.SpecialCells(xlCellTypeVisible).Copy
    wsSalary.Range("C4").PasteSpecial xlPasteValues
    Application.CutCopyMode = False

Answer 1

您可以采取一些小的应用程序更改来调整速度。

关闭更新和活动（务必事后重新开启！）

Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False

但最大的改进将来自删除复制/粘贴操作 - 尤其是使用剪贴板 - 如果您只是粘贴值，则可以执行此操作。

直接添加范围值

改变这个：

wsDV.ListObjects("DVTable").HeaderRowRange.Copy Destination:=wsSalary.Range("C3")
wsDV.ListObjects("DVTable").DataBodyRange.SpecialCells(xlCellTypeVisible).Copy
wsSalary.Range("C4").PasteSpecial xlPasteValues

对此：

Dim rgeFrom     As Range
Dim rgeTo       As Range

Dim numCols     As Long
Dim startCol    As Long
Dim startRow    As Long

Dim endCol      As Long
Dim endRow      As Long

Set rgeFrom = wsDV.ListObjects("DVTable").HeaderRowRange
numCols = rgeFrom.Columns.Count
numRows = rgeFrom.Rows.Count

startCol = 3 ' wsSalary Start Cell C3 
startRow = 3

endCol = startCol + numCols - 1
endRow = startRow + numRows - 1

Set rgeTo = Range(Cells(startRow, startCol), Cells(endRow, endCol))

rgeTo.Value = rgeFrom.Value

' Do same for next range DataBodyRange

Set rgeFrom = wsDV.ListObjects("DVTable").DataBodyRange
numCols = rgeFrom.Columns.Count
numRows = rgeFrom.Rows.Count

startCol = 3 ' wsSalary Start Cell C4
startRow = 4

endCol = startCol + numCols - 1
endRow = startRow + numRows - 1

Set rgeTo = Range(Cells(startRow, startCol), Cells(endRow, endCol))

rgeTo.Value = rgeFrom.Value

从循环内的模板工作簿创建工作簿

1 个答案: