PRセールで狙いたい 仕事の道具

スマイルSale11/4(水) 9:00〜11/12(木) 23:59

🖱️ロジクール M575SPd親指で動かすトラックボール、手首が疲れにくい私も使っていますAmazonで見る → 🖥️2台目のモニターMSI の24.5型、資料を横に開いたまま作業できる(フルHD・IPS)Amazonで見る → 🦾モニターアームエルゴトロン LX Pro、モニターを浮かせて机を広く使える(34型まで)Amazonで見る → 💾microSD 512GBAmazonベーシック、スマホやカメラの容量を一気に増やす(読み取り最大200MB/秒)Amazonで見る → 👆トラックパッドAmazonベーシック、Windows PC用のワイヤレス、2台を切り替えて使えるAmazonで見る →

ポイントアップにエントリースマイルSaleの対象商品をもっと見る 📦 プライム30日無料体験当ブログはAmazonアソシエイト・プログラムの参加者です。Amazonのアソシエイトとして、適格販売により収入を得ています。

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

2025-02-232026-10-19

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

実際のファイル

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

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

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

📚 私のおすすめ本PR

VBAPythonAI・ClaudePC仕事術

Excel マクロ&VBA やさしい教科書 Office 2024/2021 Microsoft 365対応

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

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

仕様の解説

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

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

メインプログラム

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

全ソース

実際のファイル

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

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

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

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

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

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

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

この記事を書いた人

関連記事

コメント

コメントする コメントをキャンセル

コメントするコメントをキャンセル