【Excel VBA】プルダウン項目を重複削除して作成したい 覚書

検索画面等に使用する目的で既存のデータから項目を抽出・重複削除し、

プルダウン項目を作成する構想はよく出されると思います。

重複削除のマクロやCount関数、IF関数等を組み合わせる方法が

一般的なのかと思いますが、

構造がシンプルでなくなるため構造がわかりづらくなってしまいます。

そのため、プルダウン項目自体をVBAで制御する方法を検討し、

シンプルなコードで実現できる方法を考えましたので覚書しておきます。

"プルダウン化"をクリックすると重複項目を回避しつつ、プルダウンが作成されます。

以下、コードです。

＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿

Sub SortBtnClick()

Call ListSort1
End Sub

Public Sub ListSort1()
Dim LstStr As String
Dim LstCnt As Integer

'A列最終行の取得
LstCnt = Cells(Rows.Count, "A").End(xlUp).Row

Cells(2, "BB").ClearContents
'リストボックス格納文字列（初期化）
LstStr = ""

'For Next 構文で入力されているすべての行において以下のループ処理を行う。
For i = 2 To LstCnt
'既にリストに挿入された値が元の"分類"に一致するものがあれば項目を追加しない。
        If InStr(LstStr, Cells(i, "A")) = 0 Then
        LstStr = LstStr & "," & Cells(i, "A")
        End If
Next

Cells(2, "BB").Select
With Selection.Validation
'入力規則の削除（これを入れないとエラーとなる）
.Delete
'文字列の追加
.Add Type:=xlValidateList, Formula1:="" & LstStr & ""
End With
End Sub

＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿

急所

.Add Type:=xlValidateList, Formula1:="文字列"

で文字列プルダウン項目が作成されます。

文字列は

"りんご, みかん, なし,…"

のように","で区切ればいくらでもプルダウンへ格納できます。

For To Next構文で全項目を対象ループさせ、

InStr関数で文字列内の文字検索を行い、ヒットしない場合（戻り値０）のみ

プルダウン内の文字列に追記しています。