0

我有下面的代码,我试图获取一个文件,删除其中的原始数据,然后将其保存为新文件。这两个文件都相当大,大小接近 100mb。因此,我试图复制和粘贴值的代码的以下部分花费了太长时间。关于如何减少运行时间的任何建议。谢谢

 DATA_COLUMNS = "A:" & getColumnLetter(wsConfig.Range("App_RawDataFile_Headings").Rows.Count)
 FORMULA_START_COLUMN = getColumnLetter(wsConfig.Range("App_RawDataFile_Headings").Rows.Count + 1)
 FORMULA_END_COLUMN = getColumnLetter(ws.Range("XFD2").End(xlToLeft).Column)


'-- clear the column of data from A to GM
ws.Range("$A$2:$" & Right(DATA_COLUMNS, 2) & ws.Rows.Count).ClearContents

DoEvents

'--get last column which contains the formulas
strLastCol = ws.Range("XFD2").End(xlToLeft).Address

'--resize the list object to the data rows only so it doesn't cause an error
'ws.ListObjects(1).Resize ws.Range("$A$1:$" & Right(DATA_COLUMNS, 2) & "$2")


'-- clear all the rows from 3 onwards
ws.Rows("3:" & ws.Rows.Count).ClearContents

DoEvents

wkbRawDataFile.Worksheets("RAW").Range("$A$2:$" & Right(DATA_COLUMNS, 2) & wkbRawDataFile.Worksheets("RAW").Range("A1").CurrentRegion.Rows.Count).Copy

ws.Range("A2").PasteSpecial xlPasteValues

'ws.Range(DATA_COLUMNS).PasteSpecial xlPasteValues

Application.CutCopyMode = False


ws.ListObjects(1).Resize ws.Range("A1").CurrentRegion


DoEvents

'-- close the old file
wkbRawDataFile.Close False

Set r = ws.Range("$" & FORMULA_START_COLUMN & "2:" & strLastCol)
r.Copy
ws.Range(FORMULA_START_COLUMN & "3:" & FORMULA_END_COLUMN & ws.Range("A1").CurrentRegion.Rows.Count).PasteSpecial xlPasteFormulas

Application.CutCopyMode = xlCopy

wkbAppOldPivot.RefreshAll
4

1 回答 1

-1

创建这个子:

   sub MakeItfaster()

     application.screenupdating=false
     application.calculation=xlmanual
     worksheet.displaypagebreaks=false

end sub

然后在代码顶部调用它,这将有所帮助。

call MakeItFaster
 DATA_COLUMNS = "A:" & getColumnLetter(wsConfig.Range("App_RawDataFile_Headings").Rows.Count)
 FORMULA_START_COLUMN = getColumnLetter(wsConfig.Range("App_RawDataFile_Headings").Rows.Count + 1)
 FORMULA_END_COLUMN = getColumnLetter(ws.Range("XFD2").End(xlToLeft).Column)


'-- clear the column of data from A to GM
ws.Range("$A$2:$" & Right(DATA_COLUMNS, 2) & ws.Rows.Count).ClearContents

DoEvents

'--get last column which contains the formulas
strLastCol = ws.Range("XFD2").End(xlToLeft).Address

'--resize the list object to the data rows only so it doesn't cause an error
'ws.ListObjects(1).Resize ws.Range("$A$1:$" & Right(DATA_COLUMNS, 2) & "$2")


'-- clear all the rows from 3 onwards
ws.Rows("3:" & ws.Rows.Count).ClearContents

DoEvents

wkbRawDataFile.Worksheets("RAW").Range("$A$2:$" & Right(DATA_COLUMNS, 2) & wkbRawDataFile.Worksheets("RAW").Range("A1").CurrentRegion.Rows.Count).Copy

ws.Range("A2").PasteSpecial xlPasteValues

'ws.Range(DATA_COLUMNS).PasteSpecial xlPasteValues

Application.CutCopyMode = False


ws.ListObjects(1).Resize ws.Range("A1").CurrentRegion


DoEvents

'-- close the old file
wkbRawDataFile.Close False

Set r = ws.Range("$" & FORMULA_START_COLUMN & "2:" & strLastCol)
r.Copy
ws.Range(FORMULA_START_COLUMN & "3:" & FORMULA_END_COLUMN & ws.Range("A1").CurrentRegion.Rows.Count).PasteSpecial xlPasteFormulas

Application.CutCopyMode = xlCopy

wkbAppOldPivot.RefreshAll
于 2017-02-04T02:13:31.243 回答