Excel VBAでドロップダウンリストから重複を削除し一意の値だけを残す完全ガイド

この記事では、Excel VBAを使ってワークシート上のドロップダウンリストから重複する値を削除し、一意の値だけを残す方法をご紹介します。「1回以上出現する値」だけでなく、「ちょうど1回しか出現しない値」を抽出する方法まで、両方のパターンを学ぶことができます。

ドロップダウンリストの一意の値(VBAコード早見表)

Sub Drop_Down_List_Unique_Values_At_Least_Once()

List_Location = "B3"

Data = Range(List_Location).Validation.Formula1
Data = Split(Data, ",")

Range(List_Location).Validation.Delete

Unique_Data = ""

Count = 0

For i = LBound(Data) To UBound(Data)
    Unique_Values = Split(Unique_Data, ",")
    For j = LBound(Unique_Values) To UBound(Unique_Values)
        If Data(i) = Unique_Values(j) Then
            Count = 1
            Exit For
        End If
    Next j
    If Count = 0 Then
        If Unique_Data = "" Then
            Unique_Data = Unique_Data + Data(i)
        Else
            Unique_Data = Unique_Data + "," + Data(i)
        End If
    End If
    Count = 0
Next i

Range(List_Location).Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
Formula1:=Unique_Data

End Sub

Excel VBAでドロップダウンリストに一意の値を残す方法

ここでは、ExcelワークシートのセルB3に、いくつかの国名が入ったドロップダウンリストが設定されているものとします。

しかし、ご覧のとおりリストには同じ名前が何度も含まれています。たとえば「ドイツ(Germany)」は3回、「イタリア(Italy)」は2回繰り返されています。

今回の目標は、このドロップダウンリストから重複する値を取り除き、一意の値だけを残すことです。

1. 「1回以上出現する値」を残すマクロを作成する

まずは、ドロップダウンリスト内に1回以上出現する一意の値を残すためのマクロを作成します。

たとえば、上記のリストの場合、このマクロを実行すると出力は「Germany、Italy、France、England」になります。

この目的のためのVBAコードは以下のとおりです。

⧭ VBAコード:

Sub Drop_Down_List_Unique_Values_At_Least_Once()

List_Location = "B3"

Data = Range(List_Location).Validation.Formula1
Data = Split(Data, ",")

Range(List_Location).Validation.Delete

Unique_Data = ""

Count = 0

For i = LBound(Data) To UBound(Data)
    Unique_Values = Split(Unique_Data, ",")
    For j = LBound(Unique_Values) To UBound(Unique_Values)
        If Data(i) = Unique_Values(j) Then
            Count = 1
            Exit For
        End If
    Next j
    If Count = 0 Then
        If Unique_Data = "" Then
            Unique_Data = Unique_Data + Data(i)
        Else
            Unique_Data = Unique_Data + "," + Data(i)
        End If
    End If
    Count = 0
Next i

Range(List_Location).Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
Formula1:=Unique_Data

End Sub

⧭ 実行結果:

コードを実行すると、アクティブなワークシートのセルB3のドロップダウンリストから重複する値が削除され、1回以上出現する値だけが残ります。

⧭ 注意点:

コードを実行する前に、ドロップダウンリストがあるワークシートをアクティブにすることを忘れないでください。また、実行前にリストの場所を示すセル参照を必要に応じて変更してください。

関連記事: Excelで一意の値を使ってドロップダウンリストを作成する方法(4つの方法)

2. 「ちょうど1回しか出現しない値」を残すマクロを作成する

今度は、ドロップダウンリスト内にちょうど1回しか出現しない一意の値を残すためのマクロを作成します。

たとえば、上記のリストの場合、このマクロの出力は「France、England」になります。

この目的のためのVBAコードは以下のとおりです。

⧭ VBAコード:

Sub Drop_Down_List_Unique_Values_Exactly_Once()

List_Location = "B3"

Data = Range(List_Location).Validation.Formula1
Data = Split(Data, ",")

Unique_Data = ""

Range(List_Location).Validation.Delete

Count = 0

For i = LBound(Data) To UBound(Data)
    For j = LBound(Data) To UBound(Data)
        If j <> i And Data(i) = Data(j) Then
            Count = 1
            Exit For
        End If
    Next j
    If Count = 0 Then
        If Unique_Data = "" Then
            Unique_Data = Unique_Data + Data(i)
        Else
            Unique_Data = Unique_Data + "," + Data(i)
        End If
    End If
    Count = 0
Next i

Range(List_Location).Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
Formula1:=Unique_Data

End Sub

⧭ 実行結果:

コードを実行すると、アクティブなワークシートのセルB3のドロップダウンリストから重複している値が削除され、ちょうど1回しか出現しない値だけが残ります。

⧭ 注意点:

こちらも同様に、コードを実行する前にドロップダウンリストのあるワークシートをアクティブにしてください。また、実行前にリストの場所のセル参照を必要に応じて変更してください。

関連コンテンツ: Excelのドロップダウンリストから複数選択する方法(3つの方法)

類似記事:

• 選択内容に基づいてデータを抽出するドロップダウンフィルターの作成方法
• 色付きのExcelドロップダウンリストを作成する方法(2つの方法)
• Excelのドロップダウンリストが動作しないときの対処法(8つの問題と解決策)
• Excelでドロップダウンリストを自動更新する方法(3つの方法)
• ExcelでVBAを使ってドロップダウンリストから値を選択する方法(2つの方法)

3. 一意の値をドロップダウンリストに入れるUserFormを作成する

最後に、UserForm(ユーザーフォーム)を作成して、VBAでドロップダウンリストから重複値を削除し、一意の値だけを残す方法をご紹介します。

⧪ ステップ1:UserFormを開く

VBE(Visual Basic Editor)のメニューから[挿入] > [ユーザーフォーム]を選択して、新しいUserFormを開きます。UserForm1という名前の新しいフォームが表示されます。

⧪ ステップ2:ツールボックスからコントロールを配置する

UserFormの横にはツールボックスが表示されています。ツールボックスからラベル(Label)を3つ、リストボックス(ListBox)を2つ(Label1とLabel3の下に配置)、テキストボックス(TextBox)を1つ(Label2の下に配置)を、図のようにドラッグして配置します。

最後に、コマンドボタン(CommandButton)を右下にドラッグして配置します。

⧪ ステップ3:ListBox1のコードを記述する

ListBox1をダブルクリックすると、ListBox1_ClickというPrivate Subプロシージャが開きます。そこに以下のコードを入力してください。

Private Sub ListBox1_Click()

For i = 0 To UserForm1.ListBox1.ListCount - 1
    If UserForm1.ListBox1.Selected(i) = True Then
        Worksheets(UserForm1.ListBox1.List(i)).Activate
        Exit For
    End If
Next i

End Sub

⧪ ステップ4:TextBox1のコードを記述する

次に、TextBox1をダブルクリックすると、TextBox1_Changeという別のPrivate Subプロシージャが開きます。そこに以下のコードを入力してください。

Private Sub TextBox1_Change()

On Error GoTo TB1:

ActiveSheet.Range(UserForm1.TextBox1.Text).Select

Exit Sub

TB1:
    x = 21

End Sub

⧪ ステップ5:CommandButton1のコードを記述する

最後に、CommandButton1をダブルクリックすると、CommandButton1_ClickというPrivate Subプロシージャが開きます。そこに以下のコードを入力してください。

Private Sub CommandButton1_Click()

List_Location = UserForm1.TextBox1.Text

Data = Range(List_Location).Validation.Formula1
Data = Split(Data, ",")

Range(List_Location).Validation.Delete

Unique_Data = ""

Count = 0

If UserForm1.ListBox2.Selected(0) = True Then
    For i = LBound(Data) To UBound(Data)
        Unique_Values = Split(Unique_Data, ",")
        For j = LBound(Unique_Values) To UBound(Unique_Values)
            If Data(i) = Unique_Values(j) Then
                Count = 1
                Exit For
            End If
        Next j
        If Count = 0 Then
            If Unique_Data = "" Then
                Unique_Data = Unique_Data + Data(i)
            Else
                Unique_Data = Unique_Data + "," + Data(i)
            End If
        End If
        Count = 0
    Next i

ElseIf UserForm1.ListBox2.Selected(1) = True Then
    For i = LBound(Data) To UBound(Data)
        For j = LBound(Data) To UBound(Data)
            If j <> i And Data(i) = Data(j) Then
                Count = 1
                Exit For
            End If
        Next j
        If Count = 0 Then
            If Unique_Data = "" Then
                Unique_Data = Unique_Data + Data(i)
            Else
                Unique_Data = Unique_Data + "," + Data(i)
            End If
        End If
        Count = 0
    Next i
Else
    MsgBox "Select Either At Least Once or Exactly Once.", vbExclamation
End If

Range(List_Location).Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
Formula1:=Unique_Data

End Sub

⧪ ステップ6:UserFormを実行するコードを記述する

VBEのツールバーから新しいモジュール(Module)を挿入し、そこに以下のコードを入力します。

Sub Run_UserForm()

UserForm1.Caption = "Keep Unique Values in Drop-Down List"

UserForm1.Label1.Caption = "Worksheet: "
UserForm1.Label2.Caption = "List Location: "
UserForm1.Label3.Caption = "Keep Unique Values that Appear: "

UserForm1.ListBox1.BorderStyle = fmBorderStyleSingle
UserForm1.ListBox1.ListStyle = fmListStyleOption

For i = 1 To Sheets.Count
    UserForm1.ListBox1.AddItem Sheets(i).Name
Next i

For i = 0 To UserForm1.ListBox1.ListCount - 1
    If UserForm1.ListBox1.List(i) = ActiveSheet.Name Then
        UserForm1.ListBox1.Selected(i) = True
        Exit For
    End If
Next i

UserForm1.ListBox2.BorderStyle = fmBorderStyleSingle
UserForm1.ListBox2.ListStyle = fmListStyleOption

UserForm1.ListBox2.AddItem "At Least Once"
UserForm1.ListBox2.AddItem "Exactly Once"

UserForm1.CommandButton1.Caption = "OK"

Load UserForm1
UserForm1.Show

End Sub

⧪ ステップ7:UserFormを実行する(最終結果)

これでUserFormを使用する準備が整いました。Run_UserFormというマクロを実行してください。

ワークシート上にUserFormが読み込まれます。

まず、ドロップダウンリストがあるワークシートを選択します。ここではSheet3です。

次に、リストの場所を示すセル参照を入力します。ここではB3です。

最後に、「At Least Once(1回以上)」または「Exactly Once(ちょうど1回)」のいずれかを選択します。ここでは「At Least Once」を選択しました。

すると、私のUserFormは以下のようになります。

そして「OK」をクリックします。選択した条件に従って、指定した場所のドロップダウンリストから重複する値が削除されます。

関連記事: 数式を使ってExcelでドロップダウンリストを作成する方法(4つの方法)

留意点

• この記事では、ドロップダウンリストから重複する値を削除する方法に焦点を当てました。ドロップダウンリストの作成方法や、重複を含むリストの値を並べ替える方法については、関連記事をご参照ください。

まとめ

以上が、Excel VBAを使ってドロップダウンリストから重複する値を削除し、一意の値だけを残す方法でした。ご不明な点があれば、お気軽にお問い合わせください。また、最新の投稿やアップデートについては、ぜひ当サイトExcelDemyをご覧ください。

関連記事

• Excelでセルの値とドロップダウンリストを連動させる方法(5つの方法)
• Excelの条件付きドロップダウンリスト(作成・並べ替え・活用)
• Excelで動的な依存型ドロップダウンリストを作成する方法
• IF関数を使ってExcelでドロップダウンリストを作成する方法
• ExcelでドロップダウンリストとVLOOKUPを組み合わせる方法