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

Excel VBA宏运行时间太长

1 个答案: