スポンサーリンク
前回の記事では、Excelで逆算を行う機能である「ゴールシーク」について紹介した。
今回は、そこで紹介したゴールシークのデメリットの解消にチャレンジしたマクロを作成してみた。
おさらいだが、ゴールシーク機能のデメリットは大まかに次の通りだ。
- ゴールシークのダイアログ「目標値」の欄には、必ず数値を手入力しなければならなくて、「F2」などのセル参照で記入することはできない。
- ゴールシーク機能は複数セルに対応しておらず、あくまで単一セルに答えを導き出すことしかできない。
詳細は省略するので、前回の記事を参照してね。
で、今回紹介するのがこのデメリットを解消するマクロってことだけど、複数セルに対するゴールシークを一括で実行することができるものだ。
このマクロは、個人用マクロブックに組み込んで使うと良い。
動作イメージ
ではまず動作イメージから。下図では、
②F2:F4セルが目標値を入れてる箇所。
③D2:D4セルが空白になってて数値を入れる箇所。
で、③を入力して①の値を②に一致させるってわけね。
通常のゴールシークでは、目標値をこうやって別セルにまとめておくって手法は取れないし、複数同時にはできない。
今回のマクロ、操作方法の大まかな流れは、
(2)目標値の入力されているセルと同じ列にあるセルをどこか1つ選ぶ
(3)変化させていくセルと同じ列にあるセルをどこか1つ選ぶ
というようになるけど、順を追っていく。
まずマクロを起動すると、数式入力セルを選んでくれとメッセージが出るので、数式を入れてある①E2:E4セルを正しく選ぶ。
ここで選択するセルには、全て数式が入っていないとエラーを返す。
次に、「目標値の入力されている最初のセルを選べ」とかいうメッセージが出る。
ちょっと難しい言い回しをしてるが、実はこれ、列さえ合ってればどこのセルをクリックしても良い。
この例の場合、目標値ってのは②F2:F4セルに入れてあるが、F列のうちどこかをクリックしさえすれば良い。
何でかって、最初に選んだ①E2:E4セルは2行目～4行目を選んでるけど、それに対応して同じ2行目～4行目を選ぶ仕様のマクロだからだ。
この辺、厳密に選択させようかとも思ったけど、それはやめた。
だから、もしF列のうちどこか1個のセルを選べば、該当の目標値セル範囲はF2:F4セルと自動判定するというわけだ。
最後に「変化させていく目的のセル範囲の最初のセルを選べ」とメッセージが出る。
これも先程と同様の話。
変化させていくセル範囲は正確には③D2:D4セルだけど、この場合はD列のうちどこか1つのセルをクリックすれば良い。
ここまでやれば最後には、条件を満たす値がゴールシーク機能により、③D2:D4セルに入る。
3回もダイアログ(正確にはInputBoxというやつ)を出すというのが不細工なんだけど、これ専用の新しいダイアログをオリジナルで作るとかいう手間を掛けるのは性に合わない。
何とか可能な限り手を抜いて作ったつもりのマクロだ。
この記事の解説はグダグダ長すぎるのは自覚しているが。
ソースコード
それでは最後にソースコード。
細かいテクはそれなりに使ってるけど、それの解説は割愛。
やはり目玉はゴールシークを行うGoalSeekで、これの構成は
(数式の入力されたセル範囲).GoalSeek goal:=(目標値のセル範囲), ChangingCell:=(変化させていくセル範囲)
というものだ。
流石にこんなの、私も滅多に使いはしないからイチイチ覚えたりはしてないけどね。
エラーチェックなんかは、そんなに丁寧にやってはいないので、綻びは簡単に見つかるでしょう。
ま、元のゴールシークって機能自体が割りと間に合わせ的なものだと思ってるし、このマクロの利用機会もそう多くはないだろうし、あまり深い粗探しはしないでやってほしいもんです。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 |
Sub verticalGoalSeek() '縦の連続セルを一括ゴールシーク Dim formulaRng As Range On Error GoTo myError '***Application.InputBoxのType:=8は、セル範囲を選択させるものです。*** Set formulaRng = Application.InputBox("まず、数式の入力されているセル範囲を選択してください。", Type:=8) If formulaRng.Areas.Count > 1 Then '非連続セルを選択されていたらエラーにする MsgBox "連続したセルを選択して下さい。", vbExclamation, "非連続セル選択エラー" Exit Sub End If If formulaRng.SpecialCells(xlCellTypeFormulas).Count ＜ formulaRng.Count Then '数式セル以外が含まれていたらエラーにする MsgBox "選択したセル範囲には全て数式が入っていなければなりません。", vbExclamation, "数式セル選択エラー" Exit Sub End If Dim rSize As Long Dim startR As Long Dim C_formulaRng As Long rSize = formulaRng.Rows.Count '選択されたセルの行数 With formulaRng(1) startR = .Row '選択されたセルの最初の行番号 C_formulaRng = .Column '選択されたセルの最初の列番号 End With Dim goalValueRng As Range Dim changeRng As Range Dim C_goalValueRng As Long Dim C_changeRng As Long Set goalValueRng = Application.InputBox("次に、目標値の入力されているセル範囲について、最初のセルを選択してください。始点となる1つのセルだけで構いません。", Type:=8) Set changeRng = Application.InputBox("最後に、変化させていく目的セル範囲について、最初のセルを選択してください。始点となる1つのセルだけで構いません。", Type:=8) C_goalValueRng = goalValueRng(1).Column '目標値セル範囲の列番号 C_changeRng = changeRng(1).Column '変化させていくセル範囲の列番号 Dim r As Long Call appSet For r = startR To startR + rSize - 1 '順にゴールシークしていく Cells(r, C_formulaRng).GoalSeek goal:=Cells(r, C_goalValueRng), ChangingCell:=Cells(r, C_changeRng) Next r Call appReset MsgBox "終了しました。", vbInformation, "処理終了" Exit Sub myError: Call appReset End Sub Sub appSet() 'マクロ処理中に、描画など余計なものを省略して高速化 With Application .ScreenUpdating = False '描画を省略 .Calculation = xlCalculationManual '手動計算 .DisplayAlerts = False '警告を省略。 ' .EnableEvents = False 'DisplayAlertsよりこちらを設定した方が良いのかな？ End With End Sub Sub appReset() '描画などの設定をリセット With Application .ScreenUpdating = True '描画する .Calculation = xlCalculationAutomatic '自動計算 .DisplayAlerts = True '警告を行う End With End Sub |
スポンサーリンク
