如何通过VBA代码在Excel模型中批量运行600个敏感性测试场景？

你的原代码存在几个关键问题导致无法正常工作：

1. Excel VBA中没有ScenarioManager这个对象，直接通过工作表的Scenarios集合操作场景即可。
2. Scenarios.Add方法支持一次性指定可变单元格和对应值，不需要后续调用ChangingCells.Add（这个方法本身不适用于场景对象）。
3. 原代码没有为每个场景绑定对应的输入值，这是实现批量场景的核心步骤。

假设你的600个场景输入数据存放在Sheet2的A1:D600区域（每行对应一个场景的4个输入值，顺序对应可变单元格A1、A2、A6、A9），以下是修正后的完整代码：

Sub BatchRunScenarios()
    Dim wsModel As Worksheet
    Dim wsData As Worksheet
    Dim i As Integer
    Dim scenarioName As String
    Dim changingCells As Range
    Dim scenarioValues As Variant
    
    ' 指定模型工作表（存放敏感性测试模型的工作表）
    Set wsModel = ThisWorkbook.Worksheets("Sheet1")
    ' 指定输入数据工作表（存放600个场景的输入值）
    Set wsData = ThisWorkbook.Worksheets("Sheet2")
    ' 指定可变单元格（你的模型中需要修改的输入变量位置）
    Set changingCells = wsModel.Range("A1,A2,A6,A9")
    
    ' 先清空现有场景（可选，避免重复创建）
    wsModel.Scenarios.Delete
    
    ' 循环创建600个场景
    For i = 1 To 600
        scenarioName = "Scenario " & i
        ' 读取当前场景的输入值（Sheet2中第i行的A到D列）
        scenarioValues = wsData.Range("A" & i & ":D" & i).Value
        
        ' 创建场景并赋值
        wsModel.Scenarios.Add _
            Name:=scenarioName, _
            ChangingCells:=changingCells, _
            Values:=Application.Transpose(Application.Transpose(scenarioValues)), _
            Comment:="敏感性测试场景 " & i
        
        ' 运行当前场景并保存结果（示例：将结果存入Sheet3的对应行）
        wsModel.Scenarios(scenarioName).Show
        wsModel.Range("B10").Copy ' 假设B10是模型输出结果单元格
        ThisWorkbook.Worksheets("Sheet3").Range("A" & i).PasteSpecial xlPasteValues
    Next i
    
    MsgBox "600个场景已批量运行完成！"
End Sub

关键说明： #

• 工作表指定：根据你的实际工作表名称修改wsModel和wsData的指向。
• 可变单元格：确保changingCells的范围和你模型中的输入变量位置完全一致。
• 输入数据格式：wsData中每行的列数必须和可变单元格的数量一致，顺序也要对应。
• 结果保存：示例中把输出结果存入Sheet3，你可以根据需求修改结果的存放位置和方式。

如果不需要提前创建场景，只想直接批量替换值并获取结果，也可以简化代码（跳过场景创建，直接循环赋值计算）：

Sub BatchCalculateWithoutScenarios()
    Dim wsModel As Worksheet
    Dim wsData As Worksheet
    Dim wsResult As Worksheet
    Dim i As Integer
    
    Set wsModel = ThisWorkbook.Worksheets("Sheet1")
    Set wsData = ThisWorkbook.Worksheets("Sheet2")
    Set wsResult = ThisWorkbook.Worksheets("Sheet3")
    
    For i = 1 To 600
        ' 直接给可变单元格赋值
        wsModel.Range("A1").Value = wsData.Range("A" & i).Value
        wsModel.Range("A2").Value = wsData.Range("B" & i).Value
        wsModel.Range("A6").Value = wsData.Range("C" & i).Value
        wsModel.Range("A9").Value = wsData.Range("D" & i).Value
        
        ' 等待计算完成（如果模型是自动计算可省略）
        Calculate
        
        ' 保存结果
        wsResult.Range("A" & i).Value = "Scenario " & i
        wsResult.Range("B" & i).Value = wsModel.Range("B10").Value
    Next i
    
    MsgBox "批量计算完成！"
End Sub

内容的提问来源于stack exchange，提问作者Che