代码在具有35个表格的模型中基于UserForm复选框选择计算五个单独的DataTable，其中约30个是相互依赖的。过去花了不到9分钟计算的五个表（启用计时器 - 我知道这个可能会减慢速度），直到我介绍了我认为简单的添加，即DataTables使用的两个变量之一的索引/匹配，我在开头添加（除了几个提示）代码。 通过从下拉列表（DT表格上的单元格和数据验证列表）中选择的值的索引/匹配来定位另一个工作表上的相关单元格，然后链接到驱动该表格的两个单元格之一。第二个变量总是在同一个地方（还有另一个工作表），代码在开始时激活（链接到DT工作表），最后硬编码。
这个简单的添加似乎引起了比我预期更多的问题，将计算时间延长到将近15分钟并迫使我改变计算方法。
添加索引/匹配我定义了许多新变量（全部显式）并尽可能多地组合到预定义的名称中，但最终得到了先前功能计算的错误结果，其中似乎是其中一个DT变量（静态的，没有索引/匹配来找到它）现在被忽略了，我最终得到了一个完全相同结果的表。我以前在每张桌子上使用过这个：
For Each s In Worksheets
s.Calculate
Next s
现在我用Application.Calculate替换它，它会产生所需的结果，但需要更长的时间。
这个改变的问题，我相信以前优化了计算时间（现在似乎是唯一破坏结果的东西），是Application.Calculate，如果我理解正确的话，不仅已经使计算更长，但现在也将触发计算任何其他打开的工作簿，进一步延长时间。
代码：
Option Explicit
Public closetime, OpenTime, t
Sub Sensitivities()
Dim i As Long
Dim s As Worksheet, Sens As Worksheet, BuildInput As Worksheet, GlobInput As Worksheet
Dim Combo1 As Range, Combo2 As Range, IRRs As Range, SalesPrice As Range, Multiples As Range, Combo1Dt As Range, Combo2Dt As Range
Dim IRRsDt As Range, SalesPriceDt As Range, MultiplesDt As Range, BaseYield As Range, BaseExit As Range, VarYield As Range, VarExit As Range
Dim GlobalExit As Range, PropList As Range, AllYieldsBase As Range, AllYieldsTemp As Range
Dim NIY As Integer, PropName As Integer
Dim VarYieldVal As String, PropsVal As String
Dim BuildInputData As Range, BuildInputPropNames As Range, BuildInputCategories As Range
Dim Target As Range
Set Sens = Worksheets("Sensitivities")
Set BuildInput = Worksheets("Building Input")
Set GlobInput = Worksheets("Global Input")
Set BaseYield = Sens.Range("AF2")
Set BaseExit = Sens.Range("AF4")
Set VarYield = Sens.Range("AD2")
Set VarExit = Sens.Range("AD4")
Set AllYieldsBase = BuildInput.Range("F24:DA24")
Set AllYieldsTemp = BuildInput.Range("F26:DA26")
Set GlobalExit = GlobInput.Range("H7")
Set PropList = Sheets("List Reference").Range("B4:B103")
VarYieldVal = Sens.Range("AE2").Value
PropsVal = Sens.Range("AD3").Value
Set BuildInputData = BuildInput.Range("E1:DA75")
Set BuildInputPropNames = BuildInput.Range("E3:DA3")
Set BuildInputCategories = BuildInput.Range("E1:E75")
Set Combo1 = Sens.Range("AD7:AS16")
Set Combo2 = Sens.Range("AD18:AM27")
Set IRRs = Sens.Range("AD30:AM39")
Set SalesPrice = Sens.Range("AD42:AM51")
Set Multiples = Sens.Range("AP30:AY39")
Set Combo1Dt = Sens.Range("AE8:AS16")
Set Combo2Dt = Sens.Range("AE19:AM27")
Set IRRsDt = Sens.Range("AE31:AM39")
Set SalesPriceDt = Sens.Range("AE43:AM51")
Set MultiplesDt = Sens.Range("AQ31:AY39")
UserForm1.Hide
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
.EnableCancelKey = xlDisabled
.EnableEvents = False
End With
ActiveSheet.EnableFormatConditionsCalculation = False
'MsgBox "Calculation time is likely to be extended significantly if you have " & vbNewLine & "other Workbooks open. To avoid that, close other Workbooks first."
Dim mbResult As Integer
mbResult = MsgBox("This will overwrite the sensitivities results currently shown. Would you like to save a copy of the model before proceeding?", _
vbYesNoCancel)
Select Case mbResult
Case vbYes
With ActiveWorkbook
If Not .Saved Then .SaveAs Application.GetSaveAsFilename()
End With
Case vbNo
Case vbCancel
Exit Sub
End Select
If UserForm1.CheckBox1.Value = True And UserForm1.CheckBox2.Value = True And UserForm1.CheckBox3.Value = True And UserForm1.CheckBox4.Value = True And UserForm1.CheckBox5.Value = True Then
MsgBox "You have selected all five tables - this will take up to 15 minutes to calculate."
End If
Application.Cursor = xlWait
Application.DisplayStatusBar = True
Application.StatusBar = "Calculating Sensitivities..."
OpenTime = Time
i = 1
For Each s In Worksheets
s.Unprotect Password:="Whatever"
Next
Sens.Range("BB4:BB103") = PropList.Value
AllYieldsTemp.Value = AllYieldsBase.Value
GlobalExit.FormulaR1C1 = "=Sensitivities!R4C30"
With Application.WorksheetFunction
NIY = .Match(VarYieldVal, BuildInputCategories, 0)
PropName = .Match(PropsVal, BuildInputPropNames, 0)
Set Target = .Index(BuildInputData, NIY, PropName)
Target.FormulaR1C1 = "=Sensitivities!R2C30"
End With
Set PropList = Nothing
Set BuildInputData = Nothing
Set BuildInputPropNames = Nothing
Set BuildInputCategories = Nothing
Sens.Select
Application.Calculate
If UserForm1.CheckBox1.Value = True Then
Combo1.Table ColumnInput:=VarExit
'For Each s In Worksheets
's.Calculate
'Next s
Application.Calculate
Combo1Dt = Combo1Dt.Value
End If
Set Combo1 = Nothing
Set Combo1Dt = Nothing
If UserForm1.CheckBox2.Value = True Then
GlobalExit.FormulaR1C1 = "=Sensitivities!R4C32"
Combo2.Table ColumnInput:=VarYield
'For Each s In ActiveWorkbook.Sheets
's.Calculate
'Next s
Application.Calculate
Range("N34:W42").Value = Range("N21:W29").Value
GlobalExit.FormulaR1C1 = "=Sensitivities!R4C30"
For Each s In ActiveWorkbook.Sheets
s.Calculate
Next s
Combo2Dt = Combo2Dt.Value
End If
Set Combo2 = Nothing
Set Combo2Dt = Nothing
If UserForm1.CheckBox3.Value = True Then
IRRs.Table RowInput:=VarExit, ColumnInput:=VarYield
'For Each s In ActiveWorkbook.Sheets
's.Calculate
'Next s
Application.Calculate
IRRsDt = IRRsDt.Value
End If
Set IRRs = Nothing
Set IRRsDt = Nothing
If UserForm1.CheckBox4.Value = True Then
SalesPrice.Table RowInput:=VarExit, ColumnInput:=VarYield
'For Each s In ActiveWorkbook.Sheets
's.Calculate
'Next s
Application.Calculate
SalesPriceDt = SalesPriceDt.Value
End If
Set SalesPrice = Nothing
Set SalesPriceDt = Nothing
If UserForm1.CheckBox5.Value = True Then
Multiples.Table RowInput:=VarExit, ColumnInput:=VarYield
'For Each s In ActiveWorkbook.Sheets
's.Calculate
'Next s
Application.Calculate
MultiplesDt = MultiplesDt.Value
End If
Set Multiples = Nothing
Set MultiplesDt = Nothing
AllYieldsBase.Value = AllYieldsTemp.Value
AllYieldsTemp.ClearContents
GlobalExit.Value = BaseExit.Value
Set AllYieldsBase = Nothing
Set AllYieldsTemp = Nothing
Set GlobalExit = Nothing
Set BaseExit = Nothing
Sens.Activate
For Each s In ActiveWorkbook.Sheets
s.Protect Password:="Whatever", UserInterfaceOnly:=True, DrawingObjects:=False, Contents:=True, Scenarios:=False, _
AllowFormattingCells:=False, AllowFormattingColumns:=True, AllowFormattingRows:=True, _
AllowInsertingColumns:=False, AllowInsertingRows:=False, AllowInsertingHyperlinks:=False, _
AllowDeletingColumns:=False, AllowDeletingRows:=False, AllowSorting:=True, AllowFiltering:=True, _
AllowUsingPivotTables:=True
s.EnableOutlining = True
Next
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
.EnableEvents = True
End With
ActiveSheet.Range("Q2").Select
ActiveSheet.EnableFormatConditionsCalculation = True
Application.Cursor = xlDefault
Application.StatusBar = False
closetime = Time
t = Format(closetime - OpenTime, "hh:mm:ss")
MsgBox "Opened at " & Format(OpenTime, "hh:mm:ss") _
& " Closed at " & Format(closetime, "hh:mm:ss") & vbCr & vbNewLine & _
"The calculation took " & t, vbOKOnly, "Calculation Timer"
End Sub
任何想法......？