【VBA】重複を除いたリスト(Dictionary)を作成する【UNIQUE関数は使用せず】

VBAコード

ここでは例として、
　・シート「sample」のB列「名前」の「重複した値」を使用して
　・重複を除いたリスト(Dictionary)を作成し
　・イミディエイトウインドウへ出力
します。

Option Explicit

Sub sample()

    Dim ws As Worksheet
    Dim startRange  As Range
    Dim filterColumnName As String
    Dim table As ListObject
    Dim filterdRange As Range
    Dim filterValue As Variant
    Dim dicUniqueList As Object
    Dim key As Variant

    '対象シート
    Set ws = Worksheets("sample")
    'オートフィルタを設定する表の一番左上のセル
    Set startRange = ws.Range("B2")
    'フィルタ対象の列名
    filterColumnName = "名前"
    
    '表をテーブル化してListObjectを取得
    Set table = ws.listObjects.Add(Source:=startRange.CurrentRegion, XlListObjectHasHeaders:=xlYes)
    '「フィルタ対象の列」にて重複しないように絞り込み
    table.ListColumns(filterColumnName).Range.AdvancedFilter Action:=xlFilterInPlace, Unique:=True
    '絞り込んだ範囲を取得
    Set filterdRange = table.ListColumns(filterColumnName).DataBodyRange.SpecialCells(xlCellTypeVisible)
    
    '絞り込みを解除
    If ws.FilterMode Then
        ws.ShowAllData
    End If
    
    Set dicUniqueList = CreateObject("Scripting.Dictionary")
    
    '「絞り込んだ範囲(セルの数)」の数だけ繰り返し
    For Each filterValue In filterdRange.Value
        '「値」をDictionaryへ追加
        dicUniqueList.Add filterValue, ""
    Next

    'テーブル化を解除
    With table
        .TableStyle = ""
        .Unlist
    End With
    
    '結果をイミディエイトウィンドウへ出力
    For Each key In dicUniqueList.Keys
        Debug.Print key
    Next
    
End Sub

実行結果

「重複を除いたリスト(Dictionary)」を作成できました。

参考①

上記のVBAコードは以下の記事を参考にして作成しました。

●シート上の表をテーブル化する

●シート上の表のテーブル化を解除する

参考②

上記で使用した以下の詳細は、公式サイトをご確認ください。

●「Rangeオブジェクト」の「AdvancedFilter」メソッド

●「Rangeオブジェクト」の「SpecialCells」メソッド