Question

我有一系列带有随机数的单元格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

Answer 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

创建单元格不等于零的范围

1 个答案: