【VBA】Excelの入力規則にリスト以外の値を組み入れることが出来るようにする

Excelでは、ユーザの入力ミスを予防するために入力規則（リスト）を設定することで、プルダウンリストからユーザが選択するように設定できます。

しかし、入力値が予め予想できない場合で、ユーザによる入力のばらつきを抑えるために、ユーザが入力した値でリストを作り、プルダウン選択するという機能は、通常のExcelの機能の範囲内ではある程度作り込めるものの、使いやすいものになりません。

ここでは、Excel関数とVBAを組み合わせることで、ユーザの任意の入力値でプルダウン選択を可能にする方法を解説します。

（１）Excel関数で実現する範囲

Excel関数だけであっても調子がよくないものの、ユーザの任意の値で入力規則を作ることができます。方法は次のものになります。

①入力列（D列）をそのまま別の列（L列）にコピーする
②L列全体の値から重複排除した列（M列）を作る(＝UNIQUE(L列））
③入力規則のリストの「元の値」としてM列を指定する

これは入力規則による値のチェックが、入力規則の範囲を変更後に実施されるため、新しく入力した値が入力規則のリストに加えられたあとに実施されるため、リスト外であっても入力可能になるという仕組みです。

（２）Excel関数で実現した場合の問題

M列の最終行が分からないため、多めの範囲を指定すると、プルダウンで空白のみがリストに表示され、選択可能な値が視野外（上の方）に行かないと選択できないため、ユーザビリティが非常に低くなります。

（３）ＶＢＡ等で補完して不具合を解消する

これを解消するためには、ＶＢＡで必要最小限のM列の値で入力規則を再設定するなどの対応が必要です。

（４）具体的実現方法

次の方法で実装すると、いい具合にユーザの入力値でプルダウン入力を実現することができます。

①重複排除の値
　何もしない場合Unique関数は空白値を０と見なしてリストに加えてしまいます。そのため、次のような記述とします。

=IF(UNIQUE(L4:L260)=0, "", UNIQUE(L4:L260))

最終行は固定でなく、LOOKUP(2, 1/(A:A<>""), ROW(A:A))などにしたほうがより汎用的に書けるかもしれません

②重複排除列の名前空間への設定

ここをワークシートイベントとしてＶＢＡで記述します。また最終的な入力規則（リスト）をD列全体に反映します。D列の最終行は罫線のある行としています。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim DlastRow As Long
Dim MlastRow As Long
Dim Dcell As Range
Dim namedRange As String
Dim validationRange As Range

For Each cell In Target
' D列に変更があったかどうかを確認
If Not Intersect(Target, Me.Range("D:D")) Is Nothing Then
    
    ' D列の罫線がある最終行を特定
    DlastRow = 4 ' 最小の開始行
    For Each Dcell In Me.Range("D4:D" & Me.Rows.Count)
        If Not Dcell.Borders(xlEdgeBottom).LineStyle = xlNone Then
            DlastRow = cell.Row - 1
            Exit For
        End If
    Next Dcell

    ' 名前定義範囲を作成または更新
    MlastRow = Me.Cells(Me.Rows.Count, "M").End(xlUp).Row
    namedRange = "MyDynamicList"
    On Error Resume Next ' 名前が存在しない場合のエラーを無視
    ThisWorkbook.Names(namedRange).Delete
    On Error GoTo 0 ' 通常のエラー処理に戻す
    ThisWorkbook.Names.Add name:=namedRange, RefersTo:=Me.Range("M4:M" & MlastRow)

    ' 罫線のある最終行までのD列に入力規則を更新
    Set validationRange = Me.Range("D4:D" & DlastRow)
    With validationRange.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=" & namedRange
    End With
End If
Next Cell
End Sub

いかがでしたでしょうか。役にたったら「いいね」をよろしくおねがいします。