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"、新しいリストはゼロのセルを除外します)。

ソルバー関数でループを実行しているため、毎回データが変化するため、毎回新しい範囲を単純に選択することはできません。空白のセルも選択できません。さらに、数式は各セルに基づいているため、ゼロを削除して範囲を縮小しても機能しません。セルを固定する必要があります。ゼロ以外のセルのみを選択する理由は、計算時間を大幅に短縮するためです。新品の PC で実行するのに約 5 時間かかる重いモデリングを行っています。

実際のコードは以下です。

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 に答える