“压力测试”Excel模型的框架

时间:2011-10-03 20:03:44

标签: excel vba

我有一张带有1张纸的“黑匣子”excel型号。它有2个输入,名为范围“Input1”和“Input2”,以及一个输出,它是一个命名范围“输出”。我写了一个宏来测试这个模型对它的输入变化的敏感性,但我想知道是否有更优雅的方法来做到这一点:

Sub LoopMacro()

Dim outrow As Integer
outrow = 1

For i = 1 To 10 Step 0.5
    Range("Input1").Value = i

    For j = 1 To 10 Step 0.5
        Range("Input2").Value = j

        Output outrow
        outrow = outrow + 1

    Next j
Next i
End Sub

Sub Output(outrow As Integer)

Sheets("Output").Cells(outrow, 1) = Range("Input1").Value
Sheets("Output").Cells(outrow, 2) = Range("Input2").Value
Sheets("Output").Cells(outrow, 3) = Range("Output").Value

End Sub

这个宏的问题在于它需要为每个输入变量使用for循环,如果我有多个输入则会变得相当繁琐。我试图找出是否有一种方法来编码,以便我可以定义n输入(命名为ranged“Input1”,“Input1”,“Inputn”),以及它们的最小值和最大值,并让宏自动循环输入Input1-Inputn的相关值

1 个答案:

答案 0 :(得分:1)

不确定,但这可能是您正在寻找的:只需修改包含参数名称和值范围的数组。

Sub TestModelInputs()

    Dim shtModel As Worksheet, shtResults As Worksheet
    Dim arrNames, arrMin, arrMax, arrStep, arrVals, x
    Dim rw As Long, lb, ub, n, incr As Boolean

    '###modify input parameters here
    arrNames = Array("Input1", "Input2", "Input3")
    arrMin = Array(1, 1, 1)
    arrMax = Array(4, 5, 6)
    arrStep = Array(1, 1, 1)
    '###done with parameter setup

    Set shtModel = ThisWorkbook.Sheets("Model")
    Set shtResults = ThisWorkbook.Sheets("Results")

    rw = 1
    arrVals = arrMin
    lb = LBound(arrNames)
    ub = UBound(arrNames)
    n = (ub - lb) + 1
    shtResults.UsedRange.ClearContents

    Do             
        rw = rw + 1
        For x = lb To ub
            shtModel.Range(arrNames(x)).Value = arrVals(x)
        Next x

        With shtResults.Rows(rw)
            .Cells(1).Resize(1, n).Value = arrVals
            .Cells(n + 1).Value = shtModel.Range("Output").Value
        End With

        For x = lb To ub
            If arrVals(x) < arrMax(x) Then
                arrVals(x) = arrVals(x) + arrStep(x)
                Exit For
            Else
                If x = ub Then
                    Exit Do
                Else
                    arrVals(x) = arrMin(x)
                End If
            End If
        Next x
    Loop

End Sub