ゴールシークとマクロ ② クラスモジュール化(1)
昨日は、ゴールシークの結果が本当にゴールなのか(=途中で力尽きて倒れていないか)を確認してみた。
infoment.hatenablog.com
今日は、今までの結果をクラスモジュールに移植してみる。
ゴールシークにおいて、計算式が入っているセルと値を変化させるセルは、今回のケースで何度も登場する。そこで今回も安易にクラスモジュールに移植してみた。
作戦としては、こうだ。
- 目標値に、+側から近づけてみる。
- 目標値に、-側から近づけてみる。
- 二つの結果が一致するならば、目標を導く値は一つ(=処理終了)
クラスモジュール(GoalSeekClass)
Option Explicit Public goal_cell As Range Public changing_cell As Range Public goal_value As Double Public Enum SeekDirection SeekAscending = 1 SeekDescending = -1 End Enum Public Function SingleSolutionFlag() As Boolean If SeekMax = SeekMin Then SingleSolutionFlag = True Else SingleSolutionFlag = False End If End Function Private Function SeekMax() SeekMax = GetSingleGoal(SeekAscending) End Function Private Function SeekMin() SeekMin = GetSingleGoal(SeekDescending) End Function Private Function GetSingleGoal(Optional seek_direction As SeekDirection = SeekAscending) As Double ' 初期値。 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 GetSingleGoal = WorksheetFunction.Round(changing_cell.Value, 3) End Function
標準モジュール
Sub hoge() Dim GSC As GoalSeekClass Set GSC = New GoalSeekClass Set GSC.goal_cell = Range("H3") Set GSC.changing_cell = Range("G3") GSC.goal_value = 0 MsgBox GSC.SingleSolutionFlag End Sub
結果、「答えが一つしかないフラグ」はFalseと出た。
つまり、答えは複数あるということ。
従って、
If GSC.SingleSolutionFlag = False Then
としたいところだが・・・
この先は、未だ考えてません(次回に続く)
参考まで。