ゴールシークとマクロ ① 無限遠からのアプローチ(4)
昨日は、恐らく既定の回数内に辿り着けなかったであろう「ゴールシーク」の処理について、目標値到達まで処理を繰り返させることに挑戦した。
infoment.hatenablog.com
ゴールにたどり着いたか否かについては、目標値との一致率1%未満で評価してみた。しかし目標値が0の場合、0で割り算することになって都合が悪い。そこで今日は、その解決に挑戦する。
正直、どのような方法が正解か分からない。そこで今回は目標値が0の場合、
「一致率1%未満」
に合わせて、算出した値が「0.01未満」であることを条件にしてみよう。都合が悪くなれば、改めて調整することにする。
更についでに、以下を引数にしてみた。
・変化させるセル
・目標値を求めるセル
・目標値
・+側から算出するか、-側から算出するか
Enum SeekDirection SeekAscending = 1 SeekDescending = -1 End Enum Sub GoalSeekTest(goal_cell As Range, _ changing_cell As Range, _ goal_value As Double, _ Optional seek_direction As SeekDirection = SeekAscending) ' 初期値。 Dim InitialValue As Double InitialValue = 10 ^ 30 * seek_direction changing_cell = InitialValue ' 一致率。 Dim MatchRatio(1 To 10) As Variant Dim i As Long For i = 1 To 10 goal_cell.GoalSeek Goal:=goal_value, ChangingCell:=changing_cell Select Case goal_value ' 目標値が0の場合、0.01未満になったらループを抜ける。 Case 0 If Abs(changing_cell.Value) < 0.01 Then Exit For ' 一致率が1未満になったら、ループを抜ける。 Case Else MatchRatio(i) = Abs((goal_value - goal_cell) / goal_value * 100) If i >= 2 Then If Abs(MatchRatio(i) - MatchRatio(i - 1)) < 1 Then Exit For End If End Select Next End Sub
昨日と同じ4次関数について、↓ こちらでテストしてみた。
Sub hoge() GoalSeekTest goal_cell:=Range("H3"), _ changing_cell:=Range("G3"), _ goal_value:=0, _ seek_direction:=SeekAscending End Sub
結果は良好。いくつか躓きがあったが、ようやくスタートラインに立つことが出来た。次回は、4つの答えをどうやって導き出すかに挑戦する。
参考まで。