Excel VBA 宏运行时间太长

Question

我有以下代码，我正在尝试获取一个文件，删除其中的原始数据，然后将其另存为新文件。这两个文件都相当大，大小接近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

Answer 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