入力規則設定の簡易化（VBA研究会議事録_20）

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

hirocom777.hatenadiary.org

前回は名前定義を使った入力規則に取り組みました。

でも、この方法だと組織変更があったときに現場の人が簡単に変更できないのです。今回は入力規則の設定を簡易化する方法をご紹介します。

操作する画面

それでは操作するシートの概要です。前回と同じです。部門、課、係の3つを表示するシート（入力シート）があります。

それぞれリスト形式に入力規制されています。課のリストは部門の指定にしたがって変更となり、係のリストは課の指定にしたがって変更となります。こちらも前回と同じですね。

今回は、他のシートは使わずに入力シートのみで処理します。

実際のコード

それでは実際のコードです。入力シートモジュールに記述しています。

'表示変更時の処理
Private Sub Worksheet_Change(ByVal Target As Range)

  '表示クリア時の処理
  If Target.Text = "" Then
  　'部門が空欄の時には全体をクリアする
    If Target.Address = "$C$2" Then ClearSheet
    Exit Sub
  End If
  
  'リストファイル名指定
  Dim fileName As String
  fileName = ThisWorkbook.Path & "\" & Target.Value & ".txt"

  '部門、課、変更時処理
  Select Case Target.Address
  Case "$C$2" '部門変更時処理
    Call ReadDropDownList(fileName, Target.Offset(1, 0))
    Me.Range("$C$3:$C$4").ClearContents
  Case "$C$3" '課変更時処理
    Call ReadDropDownList(fileName, Target.Offset(1, 0))
    Me.Range("$C$4").ClearContents
  End Select

End Sub

部門のセル（"$C$2"）がクリアされた場合はすべてのセルをクリアしています。そのほかのセルがクリアされた場合は処理を中止しています。セルが値付きで変更になった場合は、Excelファイルの場所の「セルの値.txt」を入力規則リストが記述してあるファイルに指定します。指定されたファイルにしたがって下のセルをクリア、設定します。

また、すべてのセルのクリアは以下のプロシージャで実行しています。

'表示のクリア
Public Sub ClearSheet()
  '部門の設定
  Call ReadDropDownList(ThisWorkbook.Path & "\部門.txt", Me.Range("$C$2"))
  Me.Range("$C$2:$C$4").ClearContents
  Me.Range("$C$3:$C$4").Validation.Delete
End Sub

実際の設定

Excelファイルの場所には、各部署の設定ファイルが配置されています。

入力規則リストファイル配下のようになっています。「営業部.txt」の場合、以下のようになります。

営業1課
営業2課

実際の入力規則の設定は、プロシージャ「ReadDropDownList」で実行しているのですが、これは以下でご紹介したものを使用しています。

hirocom777.hatenadiary.org

実際のコードを再掲してきます。

'ドロップダウンリストを設定
Private Sub ReadDropDownList(fileName As String, rng As Range)

  'ファイルを開いてを読み込み
  Dim fileNumber As Long
  fileNumber = FreeFile
  Open fileName For Input As fileNumber
  Do Until EOF(fileNumber)
    Dim readData As String
    Input #fileNumber, readData
    Dim dataList As String
    dataList = dataList & "," & readData
  Loop
  Close fileNumber
  
  '255文字を越えたリスト設定は不可
  If 255 < Len(dataList) Then
    MsgBox "255文字を越えてリスト設定はできません", vbOKOnly + vbExclamation
    Exit Sub
  End If
  
  'ドロップダウンリストを設定
  With rng.Validation
    .Delete
    If dataList = "" Then Exit Sub
    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
    xlBetween, Formula1:=dataList
  End With
End Sub

これならば、テキストファイルを編集すれば簡単に設定できます。