此工作簿用于跟踪项目，我将此VBA代码链接到表单控件按钮，当我按下按钮时，它将运行并从所有项目表中获取信息并将其提供给适当的区域。我想弄清楚如何将这些循环组合在一起，通过我的整本工作簿阅读。这是我的代码：
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
答案 0 :(得分：0)
如果这是您的整个代码，我建议您在初始化子代码后插入此代码：
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
这些设置可以为您带来不错的性能提升。
答案 1 :(得分：0)
这就是我所做的 - 在你的代码编写开始时
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