Excel:入力規則で選択された値によって他のセルの入力規則リストを変更する方法

入力規則の設定されているセルで選択された値によって、別のセルの入力規則のリストを変更する方法をVBAを使用してを作成したので覚書しておく。

Accessのフォームなどではよく使う機能で、1つ目のリストで選択された値を基に2つ目のリストに表示するリストを1つ目のリストで選択された値に関係する値だけ抽出して表示する、いわゆる親子関係を持たせることをセルの入力規則を使って実現した。

Excelには入力規則という機能があって、あらかじめセルに入力規則を設定しておくと、セルを選択した際にドロップダウンリストボックスが表示され、設定したリストから選択して入力できる。

セルに入力される値があらかじめある程度の種類に決まっている場合、入力を簡略化したり、入力間違いなどを防ぐ意味でも役に立つ機能である。

以下サンプルの説明。

サンプルファイルの構成と動作について

サンプルファイルの構成と動作について簡単に説明する。

Sheet1には、以下のような表が作成されており、商品区分と商品名、単価、数量、合計金額が列として用意されている。

また、"マスター"シートには、商品区分列に設定する入力規則のリストと商品名列に設定する入力規則の基となるリストが用意されている。

商品名リストには、商品がどの商品区分属しているかが記述されている。

商品区分列のセルを選択すると自動的にセルの入力規則のリストに"マスター"シートの商品区分リストの内容が設定される。

商品区分のリストから値を選択すると、選択された商品区分に属する商品の一覧が"マスター"シートのリストを基に商品名セルの入力規則のリストに自動的に設定される。

商品名を選択すると、単価列に選択した商品の単価が"マスター"シートのリストを基に自動的に入力される。

数量列に数値を入力すると合計額列に"数量 X 単価"の値が自動的に入力される。

商品区分で上のセルとは違う区分を選んだ場合に表示される商品名リストの例。

今回事情があってExcelでこういった処理ができるように作成したが、本来こういったものはAccessのフォームで作るのが普通だと思う。

また、Excelの入力規則のリストに設定できる文字列数に制限があるため、あまり多くのリストを設定することはできない。(確か255文字)

もしExcelでこのようなことをするのであれば、そういった制限等よく考えた上で作成すること。

各処理に必要なイベントプロシージャ(VBAのコード)について

上記の動作に必要な各イベントプロシージャについて説明する。

セルの値が変更された際に実行されるイベントプロシージャ

以下は、Sheet1でセルの値が変更された際に動作するイベントプロシージャ。

'セルの値が変更された場合に実行されるイベントプロシージャ
Private Sub Worksheet_Change(ByVal Target As Range)
Dim kubun_sub_list As String, j As Long, k As Long
    
'セルの複数選択時は処理しない
If Target.Cells.Count <> 1 Then Exit Sub
    'Sheet1の6行目以降かつ1列目のセルの内容が変更された場合のみ実行
    If Target.Row >= 6 And Target.Column = 1 Then
        kubun_sub_list = "" '入力リストを格納する変数を初期化
        
        '選択された商品区分に対応する商品の一覧を変数にセットする
        j = 2
        Do Until Worksheets("マスタシート").Range("d" & j).Value = ""
            If Worksheets("マスタシート").Range("c" & j).Value = Target.Value Then
                kubun_sub_list = kubun_sub_list & "," & Worksheets("マスタシート").Range("d" & j).Value
            End If
            j = j + 1
        Loop
        
        '変数にセットされた商品一覧を入力規則に設定する
        With Target.Offset(0, 1).Validation
            .Delete 'すでに設定されていた場合はいったん削除してリストをクリアにする
            .Add Type:=xlValidateList, Formula1:=kubun_sub_list
        End With
        Target.Offset(0, 1).Value = "" '既存の商品名データを削除
    End If
    '商品名列で商品が選択された場合のみ実行
    If Target.Row >= 6 And Target.Column = 2 Then
        
        '商品の単価をマスターシートから探して単価列に値をセットする
        k = 2
        Do Until Worksheets("マスタシート").Range("d" & k).Value = ""
            If Worksheets("マスタシート").Range("d" & k).Value = Target.Value Then
                Target.Offset(0, 2).Value = Worksheets("マスタシート").Range("e" & k).Value
                Target.Offset(0, 1).Select
                Exit Do
            End If
            k = k + 1
        Loop
    End If
    
    '数量列が変更された場合のみ実行
    If Target.Row >= 6 And Target.Column = 3 Then
        '数量 X 単価により合計額を合計額列にセットする
        Target.Offset(0, 2).Value = Target.Value * Target.Offset(0, 1).Value
        Target.Offset(1, -2).Select
    End If
End Sub

セルが選択された際に実行されるイベントプロシージャ

このプロシージャでは、商品区分列のセルが選択された際に商品区分列のセルに表示するドロップダウンリストのリストの初期化と商品区分列で選択された区分によって商品名列のセルに表示するドロップダウンリストのリストの初期化処理を行っている。

'セルが選択されたときに実行されるイベントプロシージャ
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim kubun_list As String, i As Long
'セルの複数選択時は処理しない
If Target.Cells.Count <> 1 Then Exit Sub
    '商品区分列のセルが選択された場合のみ実行
    If Target.Row >= 6 And Target.Column = 1 And Target.Validation.Value = True Then
        kubun_list = "" '商品区分リストを格納する変数を初期化
        
        'マスターシートから商品区分一覧を取得して変数にセットする
        i = 2
        Do Until Worksheets("マスタシート").Range("a" & i).Value = ""
            kubun_list = kubun_list & "," & Worksheets("マスタシート").Range("a" & i).Value
            i = i + 1
        Loop
        
        '入力規則のリストに変数の値をセットする
        With Target.Validation
            .Delete
            .Add Type:=xlValidateList, Formula1:=kubun_list
        End With
        
    End If
End Sub

サンプルExcelファイルのダウンロード

説明だけでは分かりづらいと思うのでサンプルのExcelファイルを用意してダウンロードできるようにした。

サンプルExcelファイルのダウンロード：sample.xls

サンプルファイルの使用については自己責任でお願いします。

ファイルを開いた際にVBAのコードエラーが出る場合があるようですが、無視して構いません。 確認した限りサンプルとしての使用について問題はありません。

よく読まれている記事のようなので、記事を見やすく改版しました。