1

我有一系列A1-A5带有随机数的单元格。有些数字是零（没有特定的顺序）。我想在 VBA 中创建一个新范围，排除每个等于零的单元格。最终，这个范围或单元格列表将被输入到求解器 VBA 中，用于将更改的单元格列表（即ByChange:="$M$3,$N$3,$O$3,$P$3,$Q$3,$R$3,$S$3,$T$3,$U$3,$V$3,$W$3,$X$3,$Y$3,$Z$3,$AA$3"）新列表将排除为零的单元格。

我在求解器函数上运行一个循环，所以数据每次都会改变，所以我不能每次都简单地选择新的范围。我也不能选择空白单元格。此外，公式基于每个单元格，因此通过删除零来折叠范围也不起作用。细胞需要锚定。只选择非零单元格的理由是，它大大减少了计算时间。我正在做一些繁重的建模，需要大约 5 个小时才能在全新的 PC 上运行。

实际代码如下。

Sub SolveNonLinear1()
    solverreset
    SolverOptions AssumeNonNeg:=False, derivatives:=2, RequireBounds:=False, scaling:=False
    SolverOk SetCell:="$AG$1", MaxMinVal:=1, ValueOf:=0,     ByChange:="$M$3,$N$3,$O$3,$P$3,$Q$3,$R$3,$S$3,$T$3,$U$3,$V$3,$W$3,$X$3,$Y$3,$Z$3,$AA$3",     Engine:=1, EngineDesc:="GRG Nonlinear"
    SolverAdd CellRef:="$AK$12", Relation:=1, FormulaText:="0"
    SolverAdd CellRef:="$AK$13", Relation:=3, FormulaText:="0"
    SolverAdd CellRef:="$M$12:$AA$12", Relation:=1, FormulaText:="0"
    SolverSolve UserFinish:=True
    SolverFinish
End Sub
4

1 回答 1

1

尝试这个。这段代码的作用是遍历提供的范围并检查单元格是否等于0。这个函数使用Union方法来重建一个范围

Sub Sample()
    Dim Rng As Range

    Set Rng = GetRange(ThisWorkbook.Sheets("Sheet1").Range("A1:A5"))

    If Not Rng Is Nothing Then
        'Debug.Print Rng.Address
        '
        '~~> Rest of your solver code
        ' ..... ByChange:=Rng.Address ....
    End If
End Sub

Function GetRange(Rng As Range) As Range
    Dim aCell As Range, tmpRng As Range

    For Each aCell In Rng
        If aCell.Value <> 0 Then
            If tmpRng Is Nothing Then
                Set tmpRng = aCell
            Else
                Set tmpRng = Union(tmpRng, aCell)
            End If
        End If
    Next

    If Not tmpRng Is Nothing Then Set GetRange = tmpRng
End Function
于 2013-10-29T19:29:59.333 回答