【VBA】重複のあるデータから重複のないリストを作成する

辞書に格納することにより、重複のあるデータから重複のないリストを作成するVBAを紹介します。

データを辞書に格納しリストを作成する

VBA

Sub リスト作成()

Dim myDic As Object, myKey As Variant
Dim c As Variant, varData As Variant
Dim d As String

Set myDic = CreateObject(“Scripting.Dictionary”)

With Worksheets(“Sheet1”)
    varData = .Range(“A1”, .Range(“A” & Rows.Count).End(xlUp)).Value
End With

For Each c In varData
    If Not c = Empty Then
        If Not myDic.Exists(c) Then
                    End If
    End If
Next

myKey = myDic.Keys

Sheets(“Sheet2”).Select
For i = 0 To myDic.Count – 1
    Cells(i + 1 , 1).Value = myKey(i)
Next i

Set myDic = Nothing

End Sub

解説

重複のあるデータの中からリストを作成する

Sheet1・A列の、重複のあるデータから(A1はタイトル)、Sheet2・A列へ重複を除いたデータリストを作成する

辞書を宣言（作成）する

データのあるSheet1を選択する
Sheet1の、A1(タイトル)～A列最終行までのデータを取得する

格納した全ての値について順番に検証する
値が空白でなかったなら
その値が辞書に存在しなければ（初めての値であったなら）
辞書に値を加える

辞書内の全ての値を取得

出力先のSheet2を選択
✳︎辞書の先頭データは0番目から始まる
辞書内の値をA列の1行目から順番に出力していく

辞書の参照を解除する

リストの出力を列ラベル（縦方向）ではなく、行（横方向）ラベルで出力する場合↓↓↓

Cells(1, i + 1).Value = myKey(i)
‘1行目のAから

辞書を使用せずに重複のないリストを作成する

VBA

Sub リスト作成()

Dim a, i As Long

Sheets(“Sheet1”).Select
a = Cells(Rows.Count, 1).End(xlUp).Row

Range(Cells(1, 1), Cells(a, 1)).Sort Key1:=Range(“A1”), Order1:=xlAscending, DataOption1:=xlSortTextAsNumbers, Header:=xlYes

For i = 2 To a
    If Cells(i, 1) <> Cells(i – 1, 1) Then
        Cells(i, 2) = Cells(i, 1)
    End If
Next i

Rows(“1:1”).AutoFilter
Selection.AutoFilter Field:=2, Criteria1:=”<>”
Range(Cells(1, 2), Cells(a, 2)).Copy Destination:=Sheets(“sheet2”).Cells(1, 1)
Rows(“1:1”).AutoFilter

Sheets(“Sheet2”).Select

End Sub

解説

辞書を使わない場合の例

Sheet1を選択する
データの最終行を取得する

A列を、タイトル行を除いて昇順に並べ替える

A列について、一つ上のセルと値が違ったら
B列にA列の値を入れる

1行目にオートフィルターを設定する
B列の空白以外のデータを抽出する
抽出したデータをSheet2のA列へ貼り付ける
オートフィルタの解除