셀 범위가 0과 같지 않은 범위 만들기

Question

난수가있는 A1-A5 셀 범위가 있습니다. 숫자 중 일부는 0입니다 (특정 순서 없음). VBA에서 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")의 새 목록에서 0으로 셀을 제외하는 VBA로 입력됩니다.

솔버 함수에서 루프를 실행하여 매번 데이터가 변경되므로 매번 새로운 범위를 선택하기 만하면됩니다. 빈 셀을 선택할 수 없습니다. 또한 수식은 각 셀을 기반으로하므로 0을 제거하여 범위를 축소해도 작동하지 않습니다. 세포가 고정되어야합니다. 0이 아닌 셀을 선택하는 것의 근거는 계산 시간을 크게 줄이는 것입니다. 나는 새로운 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 

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