【VBA】Excel連動プルダウンを動的生成する方法

【VBA】Excel連動プルダウンを動的生成する方法

2025-02-232026-07-04

Excelの連動プルダウンをVBAで作りたい、という要望を受けて作ってみたので書き残しておきます
WEBではよく見かける「連動する大項目→中項目→小項目」を、大項目を選ぶと中項目の候補が変わり、中項目を選ぶと小項目の候補が変わる、という形でExcel上に再現します

連動プルダウンはVBAを使わなくても実現できるんですが、マスタが複雑だったり条件付きだったりすると数式が入り組んでわかりにくくなるので、今回はVBAで入力規則を動的に書き換える前提バージョンにしています

関数と入力規則だけで作りたい、あるいは INDIRECT / FILTER などの方式を比較して選びたい方は、先に4方式を横並びで比べた記事を見てもらった方が早いです → Excelの連動プルダウンの作り方 4方式を比較(INDIRECT/FILTER)

この記事は数式では手が届きにくい、マスタが複雑・条件付きのケースをVBAで解くための特化版という位置づけです
大項目・中項目・小項目の入力規則をWorksheet_Changeで書き換える仕組みを、仕様の解説・全ソース・サンプルファイルまで通しで置いておきます

連動するプルダウンの具体例

タイトルの通りなので改めて説明する必要もないかもですが念のため・・・

例えば左のようなマスタテーブルがあった時

大項目で”大項目1″を選ぶと中項目は「中項目1、中項目2、中項目5」のいずれかを選ぶプルダウンになる
中項目で”中項目1″を選ぶと小項目は「小項目1、小項目2、小項目3、小項目4、小項目5」のいずれかを選ぶプルダウンになる
大項目、中項目、小項目の組み合わせで結果を照合する

ポイントはマスタの中項目が飛び飛びでもOK、小項目が重複しても大項目・中項目との組み合わせでユニークになる表なので例えば”小項目6″を選んでも結果はFとQが返却されるパターンがあるところ

この飛び飛び・重複ありのマスタが、後で紹介するVBAの肝になる部分です
数式で組もうとすると条件が増えるほど数式が長くなりがちなので、こういう表こそVBAで選択肢を組み立てた方がスッキリ書けるのがこの記事のポイントです

このページの最後に実際のエクセルファイルを置いてますので気になる方はダウンロードしてみてください

仕様の解説

なるべく細かく仕様の説明を書いていきますので細かい話に興味がない人は最下部にある全ソースやダウンロードできるサンプルファイルを見てください

肝心のExcel構成はこんな感じ

プルダウン機能は入力規則を使っていて大項目、中項目、小項目を順番に選ぶとマスタテーブルに沿った結果が反映するようにします※結果はマクロでも反映させます(F3セル)がXLOOKUP関数でも反映できます(F6セル)ので参考まで

タイトルの通り大項目・中項目・小項目は連動していて入力規則の元の値をVBAで書き換える仕様にしています
大項目を変えたら中項目の入力規則を作り直し、中項目を変えたら小項目の入力規則を作り直す、という流れをそのままコードにした形です

ついでに名前管理してるとVBAでも使えるので可読性が上がる気がするので個人的にはオススメ機能
セルをITEM1・ITEM2・ITEM3・RESULTのように名前付けしておくと、コードの中でアドレス指定ではなく名前で参照できるので後から見返したときに何のセルか一目で分かります

ジャベ雄

名前管理はやってない人が多いんですが、慣れると手放せなくなります

VBAを書く場所とモジュール

今回は値の変更をトリガーにする必要があるので標準モジュールではなくシートモジュールで”Worksheet”、”Change”で作成します

ここを間違えて標準モジュールに書くとイベントが発火しないので動きません
プロジェクトエクスプローラーで対象のシート(今回だと入力シート)をダブルクリックして、上部の左プルダウンでWorksheet、右プルダウンでChangeを選ぶとイベントの雛形が出てくるので、その中に処理を書いていきます

列番号は列挙型で宣言しておくのがオススメ

VBAはプログラムの中で列番号を指定することが多いのでEnumで列番号をセットしておくのがオススメ

Excelは一覧だったりマスタ用のテーブルだったり後から項目足したり削除したり変更することが多く、メンテナンスのことを考えると結構重宝します
下のようにEnumで列番号に名前を付けておくと、後で表の列がずれても宣言部の数字を直すだけで済むので、コードの本体をあちこち書き換えずに済みます

'--- 列挙型で列番号を定めておく
Enum lngCol
    item1 = 2
    item2
    item3
    result = 6
End Enum

item1に2を入れておくとitem2は自動で3、item3は4と連番になるのがEnumの便利なところ
ここでは結果列だけ飛ばしたいのでresultに改めて6を指定しています

メインプログラム

“Worksheet_Change”モジュールなのでシート内の値が変更されればプログラムが実行されるのは良いんですがどこでも発火しちゃうのでTargetのAddressと名前管理したセルのAddressが一致した時に処理が実行されるようにSelect Caseで照合ついでの条件分岐しておく

Rangeの指定をアドレスじゃなくて名前にしているのが最初に書いた名前管理の賜物

VBAの中で定数や変数にする派の人もいるのでお好みで

処理の流れをざっくり書くと、こんなステップを踏んでいます

STEP

変更されたセルを見分ける

Targetのアドレスと名前付けしたセルのアドレスをSelect Caseで照合して、大項目・中項目・小項目のどれが変わったのかで処理を分けます

STEP

下の階層の入力規則を作り直す

一度Validationを削除してから、サブルーチンで作った候補文字列を元に入力規則を付け直します
選択肢がカンマ区切りの文字列で作れるのがポイントです

STEP

下の階層の値をクリアする

大項目を変えたのに中項目・小項目が古いままだと辻褄が合わないので、下の階層の値と結果をクリアします
このクリアで再びChangeイベントが動くと二重発火するので、EnableEventsを一時的にFalseにして止めておきます

Private Sub Worksheet_Change(ByVal Target As Range)
'====================================================================================================
' 処理がわかりやすいようにセルに名前をつけて連動するプルダウン項目を作る
' Worksheet_Changeを発火トリガーにしてセルの値が変わったら動くプログラムにする
'====================================================================================================

'更新されたセルが名前を付けたセルと一致していたらプログラム実行する
On Error GoTo ErrLabel
    Select Case Target.Address
        Case Range("ITEM1").Address
            '--- 大項目のセルが更新されたら中項目の入力規則を変更する
            With Range("ITEM2").Validation
                '--- 一旦入力規則を削除
                .Delete
                '--- DeleteやBackSpaceでセルがクリアされたら処理しない
                If Len(Target.Value) > 0 Then
                    '--- 入力値の種類をリスト形式にして、リストの値はサブルーチンで生成する ※入力規則の設定は最低限にしているので他項目はお好みで
                    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=add_item_list(1, Range("ITEM1").Value, Range("ITEM2").Value, Range("ITEM3").Value)
                End If
            End With
            '--- 大項目が更新されたら中項目・小項目と結果の値をクリアする ※イベントを一時的に無効化しないと動きがおかしくなる
            Application.EnableEvents = False
            Range("ITEM2").ClearContents
            Range("ITEM3").ClearContents
            Range("ITEM3").Validation.Delete
            Range("RESULT").Value = "-"
            Application.EnableEvents = True
        
        Case Range("ITEM2").Address
            '--- 中項目のセルが更新されたら小項目の入力規則を変更する
            With Range("ITEM3").Validation
                '--- 一旦入力規則を削除
                .Delete
                '--- DeleteやBackSpaceでセルがクリアされたら処理しない
                If Len(Target.Value) > 0 Then
                    '--- 入力値の種類をリスト形式にして、リストの値はサブルーチンで生成する ※入力規則の設定は最低限にしているので他項目はお好みで
                    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=add_item_list(2, Range("ITEM1").Value, Range("ITEM2").Value, Range("ITEM3").Value)
                End If
            End With
            '--- 中項目が更新されたら小項目と結果の値をクリアする ※イベントを一時的に無効化しないと動きがおかしくなる
            Application.EnableEvents = False
            Range("ITEM3").ClearContents
            Range("RESULT").Value = "-"
            Application.EnableEvents = True
        Case Range("ITEM3").Address
            '--- DeleteやBackSpaceでセルがクリアされた場合の処理
            Range("RESULT").Value = add_item_list(4, Range("ITEM1").Value, Range("ITEM2").Value, Range("ITEM3").Value)
    End Select
On Error GoTo 0
Exit Sub

ErrLabel:
Application.EnableEvents = True
MsgBox "予期せぬエラーが発生しました", vbCritical
End Sub

コードの中でITEM1が更新されたらITEM2の入力規則を作り直し、値もクリアしているのが分かると思います
この「一つ上を選び直したら下を全部リセットする」動きがないと、中項目が古いままなのに大項目だけ変わる、といったちぐはぐな状態になってしまいます

Application.EnableEvents = Falseで一旦イベントを止めているのは、クリア処理でセルの値が変わると再びWorksheet_Changeが呼ばれて無限に近い連鎖が起きるのを防ぐためです
止めたら最後にTrueへ戻すのを忘れないようにします(戻し忘れの対処は後半のつまずきポイントで書いています)

プルダウンの選択肢を作るサブルーチン

肝になるマスタテーブルを参照してプルダウンの選択肢を作るプログラム

前提として入力規則でプルダウンを作るには”小項目6,小項目7,小項目8,小項目9,小項目10″のようにカンマ区切りの文字を作ってあげればOKなので戻り値はこの形で

引数levelでどの項目を取得したいのか指定することでどの項目まで一致する必要があるのか、返す値がどの列なのか判定してます

中でDictionary型で重複を除外しながら候補を集めているのがポイントで、これのおかげで小項目が重複していても選択肢がダブりません
マスタの上から下までループして、指定したlevelまで値が一致する行だけを拾い、まだ登録していない値だけをDictionaryに足していく流れです

Function add_item_list(level As Long, item1 As String, item2 As String, item3 As String) As String
'====================================================================================================
' マスタシートにある項目マスタから入力規則用の配列形式の文字列を返すサブルーチン
' 重複しないリストにしたいのでDictionary型で重複除外しながら値を収集する仕様
'   level:取得したい項目「中項目→1、小項目→2、欠番→3、結果→4」
'   item1:大項目の値
'   item2:中項目の値
'   item3:小項目の値
'====================================================================================================
Dim lngRow As Long
Dim objDic As New Scripting.Dictionary

With Sheet2
    ' ---表の一番上から一番下までループして一致している値だけ収集する ※テーブル化した方が良いかもしれない
    For lngRow = 2 To .Cells(Rows.Count, 2).End(xlUp).Row
        ' ---対象の項目の値が一致するかlevelより大きい場合に次のレベルとの照合をする
        If .Cells(lngRow, lngCol.item1).Value = item1 Or level < 1 Then
            If .Cells(lngRow, lngCol.item2).Value = item2 Or level < 2 Then
                If .Cells(lngRow, lngCol.item3).Value = item3 Or level < 3 Then
                    '--- まだ取得していない項目なら追加する
                    If objDic.Exists(.Cells(lngRow, level + 2).Value) = False Then
                        '--- 列の位置は表に合わせて調整 ※今回はA列を空けているのでlevel+2が対象列になる
                        objDic.Add .Cells(lngRow, level + 2).Value, .Cells(lngRow, level + 2).Value
                    End If
                End If
            End If
        End If
    Next
End With
' ---結果を取得する時に該当がなかったら"-"を返すようにしておく
If level = 4 And objDic.Count = 0 Then objDic.Add "-", "-"
' --- 最後にカンマ区切りでJoinしてあげると入力規則用で使える配列形式の文字列にできる
add_item_list = Join(objDic.Keys, ",")
End Function

戻り値がカンマ区切りの文字列なので、そのまま入力規則のFormula1に渡せば連動プルダウンの候補になります
ちなみにScripting.DictionaryをNewで使っているのでMicrosoft Scripting Runtimeの参照設定が要ります(参照設定なしで書くならCreateObjectでも動きます)

全ソース

全部くっつけただけのソースなので説明は↑で

VBAの全ソース

Option Explicit
'--- 列挙型で列番号を定めておく
Enum lngCol
    item1 = 2
    item2
    item3
    result = 6
End Enum
Private Sub Worksheet_Change(ByVal Target As Range)
'====================================================================================================
' 処理がわかりやすいようにセルに名前をつけて連動するプルダウン項目を作る
' Worksheet_Changeを発火トリガーにしてセルの値が変わったら動くプログラムにする
'====================================================================================================

'更新されたセルが名前を付けたセルと一致していたらプログラム実行する
On Error GoTo ErrLabel
    Select Case Target.Address
        Case Range("ITEM1").Address
            '--- 大項目のセルが更新されたら中項目の入力規則を変更する
            With Range("ITEM2").Validation
                '--- 一旦入力規則を削除
                .Delete
                '--- DeleteやBackSpaceでセルがクリアされたら処理しない
                If Len(Target.Value) > 0 Then
                    '--- 入力値の種類をリスト形式にして、リストの値はサブルーチンで生成する ※入力規則の設定は最低限にしているので他項目はお好みで
                    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=add_item_list(1, Range("ITEM1").Value, Range("ITEM2").Value, Range("ITEM3").Value)
                End If
            End With
            '--- 大項目が更新されたら中項目・小項目と結果の値をクリアする ※イベントを一時的に無効化しないと動きがおかしくなる
            Application.EnableEvents = False
            Range("ITEM2").ClearContents
            Range("ITEM3").ClearContents
            Range("ITEM3").Validation.Delete
            Range("RESULT").Value = "-"
            Application.EnableEvents = True
        
        Case Range("ITEM2").Address
            '--- 中項目のセルが更新されたら小項目の入力規則を変更する
            With Range("ITEM3").Validation
                '--- 一旦入力規則を削除
                .Delete
                '--- DeleteやBackSpaceでセルがクリアされたら処理しない
                If Len(Target.Value) > 0 Then
                    '--- 入力値の種類をリスト形式にして、リストの値はサブルーチンで生成する ※入力規則の設定は最低限にしているので他項目はお好みで
                    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=add_item_list(2, Range("ITEM1").Value, Range("ITEM2").Value, Range("ITEM3").Value)
                End If
            End With
            '--- 中項目が更新されたら小項目と結果の値をクリアする ※イベントを一時的に無効化しないと動きがおかしくなる
            Application.EnableEvents = False
            Range("ITEM3").ClearContents
            Range("RESULT").Value = "-"
            Application.EnableEvents = True
        Case Range("ITEM3").Address
            '--- DeleteやBackSpaceでセルがクリアされた場合の処理
            Range("RESULT").Value = add_item_list(4, Range("ITEM1").Value, Range("ITEM2").Value, Range("ITEM3").Value)
    End Select
On Error GoTo 0
Exit Sub

ErrLabel:
Application.EnableEvents = True
MsgBox "予期せぬエラーが発生しました", vbCritical
End Sub
Function add_item_list(level As Long, item1 As String, item2 As String, item3 As String) As String
'====================================================================================================
' マスタシートにある項目マスタから入力規則用の配列形式の文字列を返すサブルーチン
' 重複しないリストにしたいのでDictionary型で重複除外しながら値を収集する仕様
'   level:大項目→1、中項目→2、小項目→3
'   item1:大項目の値
'   item2:中項目の値
'   item3:小項目の値
'====================================================================================================
Dim lngRow As Long
Dim objDic As New Scripting.Dictionary

With Sheet2
    ' ---表の一番上から一番下までループして一致している値だけ収集する ※テーブル化した方が良いかもしれない
    For lngRow = 2 To .Cells(Rows.Count, 2).End(xlUp).Row
        ' ---対象の項目の値が一致するかlevelより大きい場合に次のレベルとの照合をする
        If .Cells(lngRow, lngCol.item1).Value = item1 Or level < 1 Then
            If .Cells(lngRow, lngCol.item2).Value = item2 Or level < 2 Then
                If .Cells(lngRow, lngCol.item3).Value = item3 Or level < 3 Then
                    '--- まだ取得していない項目なら追加する
                    If objDic.Exists(.Cells(lngRow, level + 2).Value) = False Then
                        '--- 列の位置は表に合わせて調整 ※今回はA列を空けているのでlevel+2が対象列になる
                        objDic.Add .Cells(lngRow, level + 2).Value, .Cells(lngRow, level + 2).Value
                    End If
                End If
            End If
        End If
    Next
End With
' ---結果を取得
If level = 4 And objDic.Count = 0 Then objDic.Add "-", "-"
'--- 最後にカンマ区切りでJoinしてあげると入力規則用で使える配列形式の文字列にできる
add_item_list = Join(objDic.Keys, ",")
End Function

実際のファイル

色々書きましたがファイルさえあれば見てわかるって方は参考にどうぞ

連動する項目ダウンロード

マクロ入りのブックなので開くときにセキュリティの警告が出ることがあります
中身が気になる場合はコードを一通り読んでから、マクロを有効化して動かしてみてください

📚 VBAの独学に効く本PR

Excel VBA塾【動画×本で学ぶ!】

たてばやし淳

パーフェクトExcel VBA

高橋宣成

Excel マクロ&VBA［実践ビジネス入門講座］完全版第3版

国本温子

私のおすすめからランダムで3冊を表示しています

VBAで連動プルダウンを作るときのつまずきポイント

ここまでの仕組みは動くんですが、Worksheet_Changeと入力規則を扱うときに引っかかりやすい所がいくつかあるのでまとめておきます
私が実際に手間取った所も混ざっているので、動かないときの見直しポイントとして使ってください

EnableEventsの戻し忘れで更新が止まる

いちばん多いのがこれで、Application.EnableEvents = FalseのあとにTrueへ戻す前にエラーで処理が止まると、イベントが無効のままになってしまいます
そうなるとその後どのセルを変えてもプルダウンが連動しなくなるので、故障したように見えて焦る所です

今回のコードではErrLabelのエラー処理でEnableEventsをTrueに戻すようにしているので、途中でコケても復帰できるようにしてあります
もし手動で止まってしまったときは、イミディエイトウィンドウでApplication.EnableEvents = Trueを実行するか、一度Excelを開き直せば戻ります

古い入力規則(Validation)が残ってしまう

入力規則を作り直すときに、先に.Deleteで古いものを消してから.Addし直すのが基本です
削除せずにAddだけしようとするとエラーになったり、前の選択肢が残ったままになったりするので、今回のコードでも一旦Deleteを挟んでいます

大項目を空欄に戻したときに小項目の入力規則が残ると不自然なので、上の階層がクリアされたら下の階層のValidationも消しておくと辻褄が合います

セルの名前(ITEM1など)を定義し忘れて動かない

このコードはセルをITEM1・ITEM2・ITEM3・RESULTという名前で参照しているので、シート側でこの名前を定義していないとエラーで止まります
コードをコピーしただけで動かないときは、まず名前ボックスや数式タブの名前の管理から、対応するセルに同じ名前が付いているかを見直すと早いです

名前を先に付けておくと、コード側はアドレスの位置がずれても名前で追いかけてくれるので、行や列を後から足しても壊れにくくなります
逆に名前を付けずにアドレス直書きにすると、表を編集したときに参照先がずれてバグの温床になりがちです

マスタの参照(Sheet2)が自分のブックと合っているか

サブルーチンの中でマスタをSheet2というシートのコード名で参照しているので、自分のブックでマスタのコード名が違うとうまく拾えません
コード名はVBE側で確認できる名前で、シート見出しの表示名とは別物なので、ここが食い違うと「一致する行が無い」ように見えて候補が空になります

自分の環境に合わせるときは、Sheet2の部分を自分のマスタシートのコード名(あるいはWorksheets(“シート名”)のような指定)に置き換えると素直に動きます

マクロ有効ブック(.xlsm)で保存する

VBAを書いたら通常の.xlsxではなくマクロ有効ブックの.xlsmで保存します
うっかり.xlsxのまま保存しようとするとマクロが消える警告が出るので、そのまま進めるとせっかく書いたコードが消えてしまいます

配布したファイルを相手が開くときはマクロのブロックが掛かることがあるので、信頼できる場所に置くか、開いたあとにコンテンツの有効化をしてもらう形になります(この辺りの挙動はExcelのバージョンやセキュリティ設定で変わります)

まとめ VBAで作るか関数で作るかの使い分け

連動プルダウンをVBAで作る方法を、入力規則をWorksheet_Changeで動的に書き換えるやり方で一通り書いてみました
大項目を選ぶと中項目、中項目を選ぶと小項目、と候補が絞り込まれる仕組みは、マスタが飛び飛びでも重複ありでも同じコードで対応できるのが強みです

ざっくりした使い分けの目安はこんな感じです

マスタがシンプルで階層も浅い → 関数と入力規則で十分(INDIRECT / FILTER など)
マスタが飛び飛び・重複あり・条件付きで数式が長くなる → VBAで候補を組み立てる(本記事)
マクロを使わせたくない・配布先でマクロが無効 → 関数方式に寄せる

関数と入力規則だけで作りたい方や、INDIRECT / FILTER を含む4方式を比較して自分の環境に合うものを選びたい方は、こちらの比較記事が近道です → Excelの連動プルダウンの作り方 4方式を比較(関数/FILTER/INDIRECT)

たまにスライサーを連動する項目で紹介するサイトがありますがそうじゃないんですよ

VBAに頼るのはあまり好ましくない気もしますが、VBAを使えば大抵のことは実現できるので頼っちゃいますね

ちょっとした機能をVBAで作ってほしい！、教えて欲しい！などあればコメントもらえれば記事にしますのでよろしくどうぞ

📚 VBAの独学に効く本PR

Excel VBA塾【動画×本で学ぶ!】

たてばやし淳

パーフェクトExcel VBA

高橋宣成

Excel マクロ&VBA［実践ビジネス入門講座］完全版第3版

国本温子