マクロを使ってExcelでツールなどを作る際、
- ダブルクリックをするごとにON-OFFが切り替わる
- ダブルクリックをするごとにリスト内を順送りする
こんな機能を実装したいことがたまにあります。
この機能を実装するコードを解説します。
この機能の実装方法には、
- コード内に切り替える値を直接書き込む方法
- セルに設定されたドロップダウンリストの値を切り替えていく方法
この2種類がありますのでお好きな方をお持ち帰りください。
切り替える値をコード内にベタ打ちするパターン
ON-OFF切替
例えば「ON/OFF」など、2つの値を切り替える場合は、
以下のようなコードを実装したいシートモジュール内に記載します。
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Dim Adrs As String: Adrs = Target.Address(0, 0) If Adrs = "C2" Then Cancel = True If Target.Value = "ON" Then Target.Value = "OFF" Else Target.Value = "ON" End If End If End Sub
Target.ValueがONならOFFを、OFFならONを、
それぞれ出力するだけの簡単なマクロですね。
ダブルクリックでこのようなスイッチを実装する場合は、
ダブルクリックでセルの編集が始まると困りますので、
Cancel = True
こちらを記載して編集モードに入らない設定にしてください。
対象のセルを指定する場合はTarget.Addressを判定しますが、
実際のマクロでは何度も使うことになりますので、
Dim Adrs As String: Adrs = Target.Address(0, 0)
このコードを冒頭で実行して変数に入れてしまうと後が楽です。
同じように「行・列」も変数に格納して、
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Dim R As Long: R = Target.Row Dim C As Long: C = Target.Column Dim Adrs As String: Adrs = Target.Address(0, 0)
このコード群をダブルクリックマクロのテンプレートとしておくのもおすすめです。
リスト内を順送り
「みかん/りんご/いちご」など、特定のリスト内をループさせたい場合は、
以下のようなコードを実装したいシートモジュール内に記載します。
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Dim Adrs As String: Adrs = Target.Address(0, 0) If Adrs = "C2" Then Cancel = True Select Case Target.Value Case "みかん": Target.Value = "りんご" Case "りんご": Target.Value = "いちご" Case "いちご": Target.Value = "みかん" Case Else: Target.Value = "みかん" End Select End If End Sub
ON-OFFの時のようにIfステートメントを使ってもいいのですが、
Select Case文を使うとよりきれいに書けますのでこちらを使いましょう。
特にCaseの行とセルに出力する行をマルチステートメント「:」で1行にすると、
上記のようにかなりコードを読みやすくできているのがわかります。
この機能を実装する場合はループしたい値が増えたり減ったりしますので、
メンテナンス性を考えるとこの書き方がベストと思います。
この機能を汎用関数化する
この機能をよく実装する方は、以下のような汎用関数を作っておきましょう。
' リスト内のループ Function 配列内を順送りする(配列 As Variant, 現在の値 As String, is空白もループに加える As Boolean) As String ' 現在の値が空ならば初項を返す If 現在の値 = "" Then 配列内を順送りする = 配列(LBound(配列)) Exit Function End If ' 現在の値が最終要素であれば初項または空白を返す If 現在の値 = 配列(UBound(配列)) Then 配列内を順送りする = IIf(is空白もループに加える, "", 配列(LBound(配列))) Exit Function End If ' 配列の要素をループ Dim i As Long For i = LBound(配列) To UBound(配列) - 1 ' 最終要素はチェック済 ' 現在の値を発見したら次の要素を返す If 配列(i) = 現在の値 Then 配列内を順送りする = 配列(i + 1) Exit Function End If Next ' 配列の要素をループ End Function
この汎用関数は、↓の実行例のように、
?配列内を順送りする(Array("みかん", "りんご", "いちご"), "みかん", False) ' ← みかんの次の「りんご」を返す
配列と現在の値を渡すと、次の値を返してくれる関数です。
この関数を利用すると、先ほどシートモジュールに書いたマクロを、
以下のように簡単に書くことができるようになります。
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Dim R As Long: R = Target.Row Dim C As Long: C = Target.Column Dim Adrs As String: Adrs = Target.Address(0, 0) Select Case Adrs Case "C2" ' ONOFF切替 Cancel = True Target.Value = 配列内を順送りする(Array("ON", "OFF"), Target.Value, False) Case "C3" ' リスト内のループ Cancel = True Target.Value = 配列内を順送りする(Array("みかん", "りんご", "いちご"), Target.Value, True) End Select End Sub
劇的にコードを簡潔にできているのがわかると思います。
2値でも3値でも同じ関数で実行できますので、
ON-OFFとリスト内ループを同じ書き方で実装できるのも便利なポイントですね。
なお、この汎用関数はシートモジュールではなく標準モジュールに記載してください。
標準モジュールに記載してそれを各シートモジュールで呼ぶ形にしないと、
記載したシートでしか使えない関数になってしまうため注意してください。
また、この関数は第3引数で「is空白もループに加える」設定を指定でき、
- Trueなら みかん→りんご→いちご→""→みかん でループ
- Falseなら みかん→りんご→いちご→みかん でループ
という使い分けを行うこともできます。
(実際上記のコードでは「ON-OFF切替」では""を含めていません)
この設定も状況に応じて使い分けてください。
セルに設定されたドロップダウンリストからループ出力するパターン
この機能とセットで使用することが多いのが、
セルの入力規則で設定したドロップダウンリストです。
このリストの中身を参照し、ドロップダウンリスト内で値をループさせるには、
以下のコードをシートモジュールに記載します。
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Dim Adrs As String: Adrs = Target.Address(0, 0) If Adrs = "C2" Then Cancel = True Target.Value = 配列内を順送りする(Split(Target.Validation.Formula1, ","), Target.Value, True) End If End Sub
先ほど作成した汎用関数「配列内を順送りする」が絶大な効果を発揮し、
拍子抜けするほど簡単なコードで実装できていますね。
入力規則で設定したリストの内容は、
設定セル.Validation.Formula1
でカンマ区切りのテキストとして取得することができます。
これをSplit関数で配列にして先ほどの関数に渡すだけで、
入力リスト内をループする処理がかけているということですね。
この処理を愚直にコード内に書こうとすると、
セル内で配列をループする必要が出てしまいます。
この機能を設置するセルごとに、
↓のレベルのコードを書く羽目になるというと大変さがわかるかと思います。
' リスト内のループ(再掲) Function 配列内を順送りする(配列 As Variant, 現在の値 As String, is空白もループに加える As Boolean) As String ' 現在の値が空ならば初項を返す If 現在の値 = "" Then 配列内を順送りする = 配列(LBound(配列)) Exit Function End If ' 現在の値が最終要素であれば初項または空白を返す If 現在の値 = 配列(UBound(配列)) Then 配列内を順送りする = IIf(is空白もループに加える, "", 配列(LBound(配列))) Exit Function End If ' 配列の要素をループ Dim i As Long For i = LBound(配列) To UBound(配列) - 1 ' 最終要素はチェック済 ' 現在の値を発見したら次の要素を返す If 配列(i) = 現在の値 Then 配列内を順送りする = 配列(i + 1) Exit Function End If Next ' 配列の要素をループ End Function
こういった処理こそ汎用関数化して、
サクサク実装できるように準備しておきましょう。