Оптимизация производительности копирования VBA

Question

Мне нужно сделать отчет, запустив этот код с 3 параметрами I, j, k. Для меня пробегает от 1 до 5, j пробег от 1 до 8, k пробег от 0 до 12. С этим прогоном мне стоит примерно 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, где вы могли бы сэкономить время при условии, вам не нужны формулы в ссылочного диапазон с пересчитывать:

• Переключение в ручной перерасчет, а затем переключиться обратно в автоматический режим в конце подпрограммы
• Использовать переменные вместо ссылок на диапазоны (вы берете статические номерные тысячи раз)
• Reference и не напрягайте листа
• использование 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