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

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