Как я могу сделать этот код эффективным, в настоящее время он занимает очень много времени, чтобы запустить код

-1

Эта книга используется для отслеживания проектов, и у меня есть этот код VBA, связанный с кнопкой Form Control, когда я нажимаю кнопку он будет проходить и получать информацию из всех листов проекта и подавать его в соответствующие области. Я хочу выяснить, как я могу объединить некоторые из этих циклов, где он читает всю мою рабочую книгу. Вот мой код:Как я могу сделать этот код эффективным, в настоящее время он занимает очень много времени, чтобы запустить код

Sub Run_ALL_InfoMacros() 

'Module 5 = WIG Sheet1, for all information to be on one sheet 

With Worksheets("Sheet1") 
    ' Clear previous data on the All projects page 
    .Rows("2:" & Rows.Count).ClearContents 

    For Each ws In ThisWorkbook.Worksheets 
     If ws.Range("A5") = "Project # :" Then 
      x = .Range("A" & Rows.Count).End(xlUp).Offset(1).row 
      .Cells(x, "A").Value = ws.Name 'classifying number 
      .Cells(x, "B").Formula = "='" & ws.Name & "'!$B$5" 'Project # 
      .Cells(x, "C").Formula = "='" & ws.Name & "'!$A$1" 'Project Name 
      .Cells(x, "D").Formula = "='" & ws.Name & "'!$B$8" 'Project Engineer 
      .Cells(x, "E").Formula = "='" & ws.Name & "'!$B$6" 'Maximo Time Charge 
      .Cells(x, "F").Formula = "='" & ws.Name & "'!$E$5" 'Material Forecast due date 
      .Cells(x, "G").Formula = "=IF('" & ws.Name & "'!$E$11>0,'" & ws.Name & "'!$E$11,TEXT(,))" 
      '.Cells(x, "G").Formula = "='" & ws.Name & "'!$E$11" 'Materials Forecast Actual 
      .Cells(x, "H").Formula = "='" & ws.Name & "'!$F$11" 'Forecast success 
      .Cells(x, "I").Formula = "='" & ws.Name & "'!$F$12" 'IFC Success 
      .Cells(x, "J").Formula = "='" & ws.Name & "'!$E$6" '30% Due 
      '.Cells(x, "K").Formula = "='" & ws.Name & "'!$E$13" '30% actual 
      .Cells(x, "K").Formula = "=IF('" & ws.Name & "'!$E$13>0,'" & ws.Name & "'!$E$13,TEXT(,))" 
      .Cells(x, "L").Formula = "='" & ws.Name & "'!$F$13" '30% success 
      .Cells(x, "M").Formula = "='" & ws.Name & "'!$E$7" '60% due 
      '.Cells(x, "N").Formula = "='" & ws.Name & "'!$E$14" '60% actual 
      .Cells(x, "N").Formula = "=IF('" & ws.Name & "'!$E$14>0,'" & ws.Name & "'!$E$14,TEXT(,))" 
      .Cells(x, "O").Formula = "='" & ws.Name & "'!$F$14" '60% Success 
      .Cells(x, "P").Formula = "='" & ws.Name & "'!$E$8" '90% due 
      '.Cells(x, "Q").Formula = "='" & ws.Name & "'!$E$15" '90% actual 
      .Cells(x, "Q").Formula = "=IF('" & ws.Name & "'!$E$15>0,'" & ws.Name & "'!$E$15,TEXT(,))" 
      .Cells(x, "R").Formula = "='" & ws.Name & "'!$F$15" '90% success 
      .Cells(x, "S").Formula = "='" & ws.Name & "'!$B$11" 'In-service Due 
      '.Cells(x, "T").Formula = "='" & ws.Name & "'!$E$16" 'In-service actual 
      .Cells(x, "T").Formula = "=IF('" & ws.Name & "'!$E$16>0,'" & ws.Name & "'!$E$16,TEXT(,))" 
      .Cells(x, "U").Formula = "='" & ws.Name & "'!$F$16" 'In-service Success 
      .Cells(x, "V").Formula = "='" & ws.Name & "'!$E$4" 'IFC Scheduled 
      '.Cells(x, "W").Formula = "='" & ws.Name & "'!$E$12" 'IFC Actual 
      .Cells(x, "W").Formula = "=IF('" & ws.Name & "'!$E$12>0,'" & ws.Name & "'!$E$12,TEXT(,))" 
      .Cells(x, "X").Formula = "='" & ws.Name & "'!$B$15" 'Non Stores Items 
      .Cells(x, "Y").Formula = "='" & ws.Name & "'!$B$16" 'Non Stores Items Ordered on time 
      .Cells(x, "Z").Formula = "='" & ws.Name & "'!$A$17" 'Non Stores Items Success 
      .Cells(x, "AA").Formula = "='" & ws.Name & "'!$B$17" 'Non Stores Items Percentage 

     End If 
    Next 

End With 

'Module 7 = WIG current & upcoming Projects, for all projects with NO Actual In-service Date Inputted 


With Worksheets("Current & Upcoming Projects") 
    ' Clear previous data on the All projects page 
    .Rows("3:" & Rows.Count).ClearContents 

    For Each ws In ThisWorkbook.Worksheets 
     If ws.Range("A5") = "Project # :" And ws.Range("E16") = "" Then 
      x = .Range("A" & Rows.Count).End(xlUp).Offset(1).row 
      .Cells(x, "A").Value = ws.Name 'classifying number 
      .Cells(x, "B").Formula = "='" & ws.Name & "'!$B$5" 'Project # 
      .Cells(x, "C").Formula = "='" & ws.Name & "'!$A$1" 'Project Name 
      .Cells(x, "D").Formula = "='" & ws.Name & "'!$B$8" 'Project Engineer 
      .Cells(x, "E").Formula = "='" & ws.Name & "'!$B$11" 'In-service Due 
      .Cells(x, "F").Formula = "='" & ws.Name & "'!$E$6" '30% Due 
      .Cells(x, "G").Formula = "='" & ws.Name & "'!$F$13" '30% Success 
      .Cells(x, "H").Formula = "='" & ws.Name & "'!$E$7" '60% due 
      .Cells(x, "I").Formula = "='" & ws.Name & "'!$F$14" '60% Success 
      .Cells(x, "J").Formula = "='" & ws.Name & "'!$E$8" '90% due 
      .Cells(x, "K").Formula = "='" & ws.Name & "'!$F$15" '90% Success 
      .Cells(x, "L").Formula = "='" & ws.Name & "'!$E$5" 'Material Forecast due date 
      .Cells(x, "M").Formula = "='" & ws.Name & "'!$F$11" 'Materials Forecast Success 
      .Cells(x, "N").Formula = "='" & ws.Name & "'!$B$15" 'Non Stores Items 
      .Cells(x, "O").Formula = "='" & ws.Name & "'!$B$16" 'Non Stores Items Ordered on time 
      .Cells(x, "P").Formula = "='" & ws.Name & "'!$A$17" 'Non Stores Items Success 
     End If 
    Next 

End With 

'Module 2 = WIG Completed Project Info , For all the projects that are already in-service. 

With Worksheets("Completed Project Info") 
    ' Clear previous data on the All projects page 
    .Rows("3:" & Rows.Count).ClearContents 

    For Each ws In ThisWorkbook.Worksheets 
     If ws.Range("A5") = "Project # :" And ws.Range("E16") >= Sheet6.Range("F1") Then 
      x = .Range("A" & Rows.Count).End(xlUp).Offset(1).row 
      .Cells(x, "A").Value = ws.Name 'classifying number 
      .Cells(x, "B").Formula = "='" & ws.Name & "'!$B$5" 'Project # 
      .Cells(x, "C").Formula = "='" & ws.Name & "'!$A$1" 'Project Name 
      .Cells(x, "D").Formula = "='" & ws.Name & "'!$B$8" 'Project Engineer 
      .Cells(x, "E").Formula = "='" & ws.Name & "'!$B$11" 'In-service Due 
      .Cells(x, "F").Formula = "='" & ws.Name & "'!$E$16" 'In-service Actual 
      .Cells(x, "G").Formula = "='" & ws.Name & "'!$E$6" '30% Due 
      '.Cells(x, "H").Formula = "='" & ws.Name & "'!$E$13" '30% actual 
      .Cells(x, "H").Formula = "='" & ws.Name & "'!$F$13" '30% Success 
      .Cells(x, "I").Formula = "='" & ws.Name & "'!$E$7" '60% due 
      '.Cells(x, "J").Formula = "='" & ws.Name & "'!$E$14" '60% actual 
      .Cells(x, "J").Formula = "='" & ws.Name & "'!$F$14" '60% Success 
      .Cells(x, "K").Formula = "='" & ws.Name & "'!$E$8" '90% due 
      '.Cells(x, "L").Formula = "='" & ws.Name & "'!$E$15" '90% actual 
      .Cells(x, "L").Formula = "='" & ws.Name & "'!$F$15" '90% Success 
      .Cells(x, "M").Formula = "='" & ws.Name & "'!$E$5" 'Material Forecast due date 
      '.Cells(x, "N").Formula = "='" & ws.Name & "'!$E$11" 'Materials Forecast Actual 
      .Cells(x, "N").Formula = "='" & ws.Name & "'!$F$11" 'Materials Forecast Success 
      .Cells(x, "O").Formula = "='" & ws.Name & "'!$B$15" 'Non Stores Items 
      .Cells(x, "P").Formula = "='" & ws.Name & "'!$B$16" 'Non Stores Items Ordered on time 

     End If 
    Next 

End With 



'For Non-Stores Material 

With Worksheets("Data Sheet") 
    ' Clear previous data on the All projects page 

    .Rows("141:" & Rows.Count).ClearContents 

    For Each ws In ThisWorkbook.Worksheets 
     If ws.Range("A5") = "Project # :" Then 
    Dim Z As Integer 
    Z = 19 

    Do While Not ws.Range("A" & Z) = "" And Not IsNull(ws.Range("A" & Z)) 
     x = .Range("A" & Rows.Count).End(xlUp).Offset(1).row 
     .Cells(x, "A").Value = ws.Name 'classifying number 
     .Cells(x, "B").Formula = "='" & ws.Name & "'!$A$" & Z 'Non-stores material 
     .Cells(x, "D").Formula = "='" & ws.Name & "'!$C$" & Z 'Lead Time 
     .Cells(x, "F").Formula = "='" & ws.Name & "'!$E$" & Z 'Order By Date 
     .Cells(x, "G").Formula = "='" & ws.Name & "'!$F$" & Z 'Date Ordered 
     .Cells(x, "H").Formula = "='" & ws.Name & "'!$G$" & Z 'Goals Met 
     Z = Z + 1 
    Loop 

     End If 
    Next 

End With 




End Sub

источник

2016-08-15 Max Fitzgerald

Выключить автоматический расчет на весь срок действия вашего кода: http://stackoverflow.com/documentation/excel-vba/1107/vba-best-practices/5925/switch-off-functionalit y-in-macro-execution # t = 201608152228470642729 – Mikegrann

Вы также можете отправить на [http://codereview.stackexchange.com/] – mrbungle

Где я могу добавить код, чтобы отключить автоматический расчет? –

Если это весь ваш код, который я предложил бы вставить это сразу после инициализации вашего суб:

screenUpdateState = Application.ScreenUpdating 

statusBarState = Application.DisplayStatusBar 

calcState = Application.Calculation 

eventsState = Application.EnableEvents 

Application.ScreenUpdating = False 

Application.DisplayStatusBar = False 

Application.Calculation = xlCalculationManual 

Application.EnableEvents = False

В самом конце кода (выше End Sub) обратная это:

Application.ScreenUpdating = screenUpdateState 

Application.DisplayStatusBar = statusBarState 

Application.Calculation = calcState 

Application.EnableEvents = eventsState

Эти настройки должны дать вам хорошее повышение производительности.

источник

2016-08-16 08:35:27 daZza

Это то, что я делаю - в начале вашего кода записи

Call OnStart

В конце Написать

Call OnEnd

Где-то пишут следующее:

Public Sub OnEnd() 

    Application.ScreenUpdating = True 
    Application.EnableEvents = True 
    Application.AskToUpdateLinks = True 
    Application.DisplayAlerts = True 
    Application.Calculation = xlAutomatic 

    Application.StatusBar = False 

End Sub 

Public Sub OnStart() 

    Application.ScreenUpdating = False 
    Application.EnableEvents = False 
    Application.AskToUpdateLinks = False 
    Application.DisplayAlerts = False 
    Application.Calculation = xlAutomatic 

    ActiveWindow.View = xlNormalView 

End Sub

источник

2016-08-16 08:37:27 Vityata

Как я могу сделать этот код эффективным, в настоящее время он занимает очень много времени, чтобы запустить код

ответ

Смежные вопросы