Excel VBA宏花费太长的时间运行

问题描述：

我有下面的代码，我试图将一个文件，删除和原始数据放在里面，然后将它保存为一个新文件。这两个文件都相当大，接近100MB的大小。因此，我试图复制和粘贴值的代码的下面部分需要很长时间。有关如何减少运行时间的任何建议。由于Excel VBA宏花费太长的时间运行

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

尝试http://codereview.stackexchange.com/进行优化。 – Cyril

如果您的电子表格大小为100mb，那么可能需要考虑将数据移动到更合适的后端（如实际数据库）。 – Comintern

以我个人的经验来看，任何大于30MB的工作簿都是一个等待被破坏的定时炸弹。我希望你有副本。 –

答

创建此子：

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

Excel VBA宏花费太长的时间运行

相关推荐