ゴールシークとマクロ ① 無限遠からのアプローチ（３）

前回は、ゴールシークとの開始値を大きくしすぎると、高次の関数に於いて正しい解が求まらないという問題にぶち当たった。
infoment.hatenablog.com
今回は、この点について更に検証してみる。
f:id:Infoment:20190331112843p:plain
検証方法は、以下の通り単純だ。

Sub GoalSeekTest()
    Range("G3") = 10 ^ 30
    Range("H3").GoalSeek Goal:=0, ChangingCell:=Range("G3")
    
    ↓追加｡
    Range("H3").GoalSeek Goal:=0, ChangingCell:=Range("G3")
End Sub

どのような仕掛けでゴールを探しているかは分からないが、もしゴールにたどり着く前に規定の試行回数に達しているのなら、再度探させればよい。

確認してみたところ、３回の追加で正しい解に辿り着いた。そうか、40kgの玄米を精米機に投入して、100円しか入れていなかったということか（※100円で10kg精米）。答えに辿り着く筈もない。

と、ここで気づいた。そもそも、ゴールシークの値が正しいことを、どのように確認すれば良いのか。これが、昨日に続く第２の躓き。

そこで対策として、以下を考えてみた。
案１）得られた解で繰り返し１０回ほどゴールシークしてみる。
案２）得られた解と目標値の差で評価する。
案３）得られた解の、目標値に対する一致率で評価する。

案１は、得られた解の正しさに確証が持てないうえに、無駄も多い気がする。３回目で正解が出ていたなら、残り７回は無駄になる。却下。

案２は、求める値が１億の時もあれば、0.01の時もあるだろうから、「差」という絶対値で評価するのは難しい気がする。却下。

案３は、一致率何％が妥当なのか。自分で決めるしかない。しかし、その正しさを担保するものが無い。却下。

結局今回は、「直前の一致率との差が１未満になるまで」とすることにした。更に保険を掛け、11回目は行わないことにする。

Sub GoalSeekTest()

    ' 目標値。
    Dim TargetValue As Double
        TargetValue = 0
    
    ' 初期値。
    Dim InitialValue As Double
        InitialValue = 10 ^ 30
        Range("B3") = InitialValue
    
    ' 一致率。
    Dim MatchRatio(1 To 10) As Variant
    Dim i As Long
        For i = 1 To 10
            Range("H3").GoalSeek Goal:=TargetValue, ChangingCell:=Range("G3")
            MatchRatio(i) = Abs((TargetValue - Range("G3")) / TargetValue * 100)
            
            ' 一致率が１未満になったら、ループを抜ける。
            If i >= 2 Then
                If Abs(MatchRatio(i) - MatchRatio(i - 1)) < 1 Then
                    Exit For
                End If
            End If
        Next
End Sub