プルダウンリストを作成する ③ 使うものだけ表示

昨日は、プルダウンリスト項目のうち、重複や空白を除去する方法について考えてみた。
infoment.hatenablog.com
今日は、プルダウンリストに全ての選択肢を表示するのではなく、使うものだけ表示することに挑戦する。

例えば、選択肢がこれだけあるとする。

しかしもし選ぶ人が、何某かの都合で「野菜しか選ばない」としたら。

このように毎回、ドロップダウンリストをスクロールして、下方の項目を選ぶことになる。これは不幸だ。
ということで、プチ働き方改革。ドロップダウンリストの内容自体を、ユーザーで選べるようにしてみよう。

まず、リスト候補でテーブルを作成する。一列目には選択肢を、そして二列目には「ドロップダウンリストに含めるか否か」を記してもらう。〇印があれば、ドロップダウンリストとして表示される仕掛けとなっている。

今回も、連想配列で分別してみる。例えば、こんな感じで。

Function ListArray() As Variant
    Dim Dict As Object
    If Dict Is Nothing Then
        Set Dict = CreateObject("Scripting.Dictionary")
        Dim ListRow As Excel.ListRow
        Dim myKey As String
        Dim myItem As String
            For Each ListRow In ActiveSheet.ListObjects(1).ListRows
                myKey = ListRow.Range.Cells(1)
                myItem = ListRow.Range.Cells(2)
                If Dict.Exists(myKey) = False And myItem = "〇" Then
                    Dict(myKey) = myItem
                End If
            Next
    End If
    ListArray = Dict.Keys
End Function

表示列に「〇」があって、且つ辞書（連想配列）に未登録の場合に限り、辞書に登録していく。「〇」が付いたものだけの辞書が完成するので、後はそのkey情報を取り出してドロップダウンリストに利用する。

早速、↓ テスト。

Sub SetList(target_range As Range, arr As Variant)
    target_range.Validation.Delete
    target_range.Validation.Add Type:=xlValidateList, _
                                AlertStyle:=xlValidAlertStop, _
                                Operator:=xlBetween, _
                                Formula1:=Join(arr, ",")
End Sub

Sub test()
    SetList Selection, ListArray
End Sub

結果は、上手くいった模様。

ただし欠点もある。この仕掛けを知らない人は、ドロップダウンリストだけを見たとき、候補として「カワハギ」があることを知り得ないのだ。

というこで今日の方式もまた、採用は時と場合と、そして各自のお好み次第ということで。

参考まで。