名前定義と入力規則（VBA研究会議事録_19）

VBA研究会で論じられた内容を記録する議事録の19本目（2023/06/17開催分）です。前回の議事録はコチラになります。

hirocom777.hatenadiary.org

前回はTEXTBEFOR/TEXTAFTER関数に取り組みました。同じ機能でもいろいろな実現方法があって学びになりますね。

今回は名前定義を使った入力規則です。

今回のお題

それでは今回のお題です。部門、課、係の3つを表示するシート（入力シート）があります。

それぞれリスト形式に入力規制されています。課のリストは部門の指定にしたがって変更となり、係のリストは課の指定にしたがって変更となります。

リストの設定内容については、別シート（設定シート）に以下の様に設定されています。

名前列にはすべての部門、課の名前が列挙されています。各名前の右側には選択時に下の部署に設定されるリストが記載されています。設定されているリストの範囲には、該当する部門、課の名前が定義されています。

課、係はこの名前を指定したINDIRECT関数を使っての入力規制を設定しています。

名前定義の表示

最初のお題は名前定義の表示です。このブックに設定されている「名前定義」と「参照範囲」をイミディエイトウィンドウに表示してください。コードは以下のようになりました。

'ワークブック内のセルの名前一覧を表示。
Public Sub DispNameList()
Dim objNameList As Excel.Name
  For Each objNameList In ThisWorkbook.Names
    Debug.Print objNameList.Name, objNameList
  Next
End Sub

実行してみるとイミディエイトウィンドウには以下のように表示されました。

営業1課       =設定!$B$6
営業2課       =設定!$B$7:$C$7
営業部        =設定!$B$3:$E$3
経理課        =設定!$B$12
事務1課       =設定!$B$8:$C$8
事務2課       =設定!$B$9:$C$9
事務3課       =設定!$B$10:$C$10
事務部        =設定!$B$4:$D$4
人事課        =設定!$B$11
総務部        =設定!$B$5:$C$5
部門          =設定!$B$2:$D$2

名前定義の変更

以上を踏まえて次のお題です。部署構成の変更が発生した場合、設定シートの内容を変更するとになりますが、名前定義の内容も変更しなければなりません。この作業を自動化できないかというわけです。

以下のコードをご紹介します。設定シートに記述しています。

'入力規制用の名前定義を再設定
Sub ChangeListName()
  
  '名前定義の削除
  DeleteNameList '
  
  '設定範囲
  Dim rngArea As Range
  Dim rngList As Range
  Set rngArea = Me.Range("$A$1:$F$17")
  Set rngList = Application.Intersect(rngArea, Me.Range("A:A"))

  '再設定
  Dim rng As Range
  Dim rngNameArea As Range
  For Each rng In rngList
    If rng.Address <> "$A$1" Then
        If rng.Value = "" Then Exit For
        
        '各列のリストを取得
        Set rngNameArea = rng.Offset(0, 1)
        If rngNameArea.Offset(0, 1).Value <> "" Then
          Set rngNameArea = Range(rngNameArea, rngNameArea.End(xlToRight))
        End If
        
        '名前を付ける
        rngNameArea.Name = rng.Value
    End If
  Next

End Sub

最初にすべての名前定義を削除してから、設定範囲（"$A$1:$F$17"）についてリストを再設定します。最初に項目1列の内容を範囲として設定。項目2列より右にも設定がある場合には範囲を広げたのちに名前を設定します。

名前定義の削除については以下のプロシージャで実行しています。

'ワークブック内の名前の一覧を配列で取得します。
Public Function DeleteNameList() As String()
Dim objNameList As Excel.Name
  For Each objNameList In ThisWorkbook.Names
    Range(objNameList).Name.Delete
  Next
End Function

設定シートを変更してChangeListNameを実行すると、設定リストの内容がドロップダウンリストに反映されていることがわかると思います。