优化VBA的复制性能

Question

我必须通过使用3个参数I，j，k运行这些代码来生成报告。 对于i从1至5， Ĵ运行从1至8，从0至12 有了这个运行 K运行，它的成本我大约8分钟才能完成此运行。 但我可以运行到数千行。我如何优化此代码以更快运行？

`Option Explicit 
Sub CopySensMP() 
Sheets("Sens By MP").Activate 
Application.ScreenUpdating = False 
Dim ts, te As Variant 
ts = Time 
Dim i, j, k As Integer 
For k = 0 To Range("Tbl_Sens_Scenerio").Rows.Count - 1 
For i = 1 To Range("Sens_MP_End") 
    Cells(i + 34 + k * Range("Sens_MP_End"), 15).Value = Range("Tbl_Sens_Scenerio").Cells(k + 1, 3).Value 
    Cells(i + 34 + k * Range("Sens_MP_End"), 16).Value = Range("Tbl_Sens_Scenerio").Cells(k + 1, 4).Value 
    Cells(i + 34 + k * Range("Sens_MP_End"), 17).Value = Range("Tbl_Sens_Scenerio").Cells(k + 1, 5).Value 
    Cells(i + 34 + k * Range("Sens_MP_End"), 18).Value = Range("Tbl_Sens_Scenerio").Cells(k + 1, 6).Value 
    Cells(i + 34 + k * Range("Sens_MP_End"), 19).Value = Range("Tbl_Sens_Scenerio").Cells(k + 1, 7).Value 
    Cells(i + 34 + k * Range("Sens_MP_End"), 5) = Range("Tbl_Sens_Scenerio").Cells(k + 1, 2) & " - MP" & Application.WorksheetFunction.Text(i, "000") 
     For j = 1 To Range("Tbl_Sens_Plan").Count 
     Cells(i + 34 + k * Range("Sens_MP_End"), 5 + j).Value = Range("Tbl_Sens_MP").Cells(i, j).Value 
     Cells(i + 34 + k * Range("Sens_MP_End"), 14).Value = Range("Tbl_Sens_Result").Cells(i, 8 + k * 10).Value 
     Cells(i + 34 + k * Range("Sens_MP_End"), 20).Value = Range("Tbl_sens_result").Cells(i, 2 + k * 10).Value 
     Cells(i + 34 + k * Range("Sens_MP_End"), 21).Value = Range("Tbl_sens_result").Cells(i, 3 + k * 10).Value 
     Cells(i + 34 + k * Range("Sens_MP_End"), 22).Value = Range("Tbl_sens_result").Cells(i, 4 + k * 10).Value 
     Cells(i + 34 + k * Range("Sens_MP_End"), 23).Value = Range("Tbl_sens_result").Cells(i, 5 + k * 10).Value 
     Cells(i + 34 + k * Range("Sens_MP_End"), 24).Value = Range("Tbl_sens_result").Cells(i, 6 + k * 10).Value 
     Cells(i + 34 + k * Range("Sens_MP_End"), 27).Value = Range("Tbl_sens_result").Cells(i, 7 + k * 10).Value 
     Cells(i + 34 + k * Range("Sens_MP_End"), 28).Value = Range("Tbl_sens_result").Cells(i, 1 + k * 10).Value 
     Next j 
    Next i 
Next k 
te = Time 
Debug.Print te, ts 
Application.ScreenUpdating = True 
MsgBox "Done" 
End Sub` 

Answer 1

Bulletpoints在那里你可以节省时间，假设你不需要在引用的范围S的公式重新计算：

• 切换到手动重新计算，然后在程序结束时切换回自动
• 使用变量而不是范围引用（你把一个静态的数十万次）
• 参考，不激活片
• 使用Long类型，而不是Integer
• 使用Value2而不是Value

考虑到上述情况这里有一个简单的程序，我敢肯定，这可以进一步提高（(i + 34 + k * sens_mp_end)保存为一个变量，等等）。

Sub CopySensMP() 
'Sheets("Sens By MP").Activate 
Dim wb As Workbook, ws As Worksheet, sens_mp_end As Long 
Set wb = ActiveWorkbook 
Set ws = wb.Sheets("Sens By MP") 
Application.ScreenUpdating = False 
Application.Calculation = xlCalculationManual 'manual calculation to the rescue 
Dim ts, te As Variant 
ts = Time 
Dim i, j, k As Long 'Integer 
sens_mp_end = Range("Sens_MP_End") 'why would you call a range for a static number this many times? 
For k = 0 To Range("Tbl_Sens_Scenerio").Rows.Count - 1 
For i = 1 To sens_mp_end 
    ws.Cells(i + 34 + k * sens_mp_end, 15).Value2 = Range("Tbl_Sens_Scenerio").Cells(k + 1, 3).Value2 
    ws.Cells(i + 34 + k * sens_mp_end, 16).Value2 = Range("Tbl_Sens_Scenerio").Cells(k + 1, 4).Value2 
    ws.Cells(i + 34 + k * sens_mp_end, 17).Value2 = Range("Tbl_Sens_Scenerio").Cells(k + 1, 5).Value2 
    ws.Cells(i + 34 + k * sens_mp_end, 18).Value2 = Range("Tbl_Sens_Scenerio").Cells(k + 1, 6).Value2 
    ws.Cells(i + 34 + k * sens_mp_end, 19).Value2 = Range("Tbl_Sens_Scenerio").Cells(k + 1, 7).Value2 
    ws.Cells(i + 34 + k * sens_mp_end, 5) = Range("Tbl_Sens_Scenerio").Cells(k + 1, 2) & " - MP" & Application.WorksheetFunction.Text(i, "000") 
     For j = 1 To Range("Tbl_Sens_Plan").Count 
      ws.Cells(i + 34 + k * sens_mp_end, 5 + j).Value2 = Range("Tbl_Sens_MP").Cells(i, j).Value2 
      ws.Cells(i + 34 + k * sens_mp_end, 14).Value2 = Range("Tbl_Sens_Result").Cells(i, 8 + k * 10).Value2 
      ws.Cells(i + 34 + k * sens_mp_end, 20).Value2 = Range("Tbl_sens_result").Cells(i, 2 + k * 10).Value2 
      ws.Cells(i + 34 + k * sens_mp_end, 21).Value2 = Range("Tbl_sens_result").Cells(i, 3 + k * 10).Value2 
      ws.Cells(i + 34 + k * sens_mp_end, 22).Value2 = Range("Tbl_sens_result").Cells(i, 4 + k * 10).Value2 
      ws.Cells(i + 34 + k * sens_mp_end, 23).Value2 = Range("Tbl_sens_result").Cells(i, 5 + k * 10).Value2 
      ws.Cells(i + 34 + k * sens_mp_end, 24).Value2 = Range("Tbl_sens_result").Cells(i, 6 + k * 10).Value2 
      ws.Cells(i + 34 + k * sens_mp_end, 27).Value2 = Range("Tbl_sens_result").Cells(i, 7 + k * 10).Value2 
      ws.Cells(i + 34 + k * sens_mp_end, 28).Value2 = Range("Tbl_sens_result").Cells(i, 1 + k * 10).Value2 
     Next j 
    Next i 
Next k 
te = Time 
Debug.Print te, ts 
Application.Calculation = xlCalculationAutomatic 
Application.ScreenUpdating = True 
MsgBox "Done" 
End Sub