プルダウンリストを作成する ② 重複及び空白を除去

昨日は、プルダウンリストの作成方法を三つ紹介した。
infoment.hatenablog.com

しかし実際、選択肢が綺麗にリスト化されていない場合もある。重複していたり、空白があったり。

そこで今回は、それに対応する場合について検討する。

例えば、↓ この範囲をリストに充てたいとする。

このように、範囲全体をリストの範囲に充てると

何度も同じ候補が登場してしまう。

そこで、指定範囲の文字列から重複と空白を除去し、配列を作成するユーザー定義関数を作成する。重複削除のために、今回は辞書（連想配列）を用いる。

Function ListArray(target_range As Range) As Variant
    Static Dict As Object
    If Dict Is Nothing Then
        ' このマクロを単独で流用可能とするために、今回は参照設定を避けてみた。
        Set Dict = CreateObject("Scripting.Dictionary")
        Dim r As Range
            For Each r In target_range
                If r.Value <> vbNullString Then
                    ' 重複削除のためなので、itemは不問。今回は数字の1とした。
                    Dict(r.Value) = 1
                End If
            Next
    End If
    ListArray = Dict.Keys
End Function

先程の例で、早速テストしてみよう。

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(Range("E1:E11"))
End Sub

結果は、一応成功。

使うか使わないかは、時と場合と各自のお好み次第ということで。

参考まで。