Excel VBA宏花费太长时间才能运行

Question

I have the below code where I am trying to take one file, delete and the raw data in it and then saving it as a new file. Both the files are fairly large and close to about 100mb in size. Hence, the below part of the code where i am trying to copy and paste the values is taking too long. Any suggestions on how to reduce the run-time. Thanks

 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

create this sub:

   sub MakeItfaster()

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

end sub

then call it at the top of your code and this will help.

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