【エクセルマクロ】重複しないデータを別シート抽出(動画あり)

エクセルマクロで、重複しないリストを別シート抽出するマクロコードをご紹介します。

このページのマクロコードは、コピペで使えます。
ぜひお試しください！

重複しないデータを別シート抽出

以下のマクロを実行すると、重複データをチェックして別シートに転記します。

Sub 重複がないデータを別シート抽出()

Dim myDic As Object
Dim myKey As Variant
Dim myList As Variant
Dim i As Long
Dim Sht1 As Worksheet
Dim Sht2 As Worksheet

    Set myDic = CreateObject("Scripting.Dictionary")

    Set Sht1 = Sheets("Sheet1")
    Set Sht2 = Sheets("Sheet2")

    'A列を配列に格納
    myList = Sht1.Range("A2", Range("A" & Rows.Count).End(xlUp)).Value

    '連想配列にデータを格納
    For i = 1 To UBound(myList)

        '空欄じゃなければ
        If Not myList(i, 1) = Empty Then
            If Not myDic.exists(myList(i, 1)) Then

                '重複しない値を取得
                myDic.Add Key:=myList(i, 1), Item:=myList(i, 1)
            End If
        End If
    Next i

    '重複していない値を格納
    myKey = myDic.keys

    '別シートに出力
    For i = 0 To UBound(myKey)
        Sht2.Cells(i + 1, 1).Value = myKey(i)
    Next i

    '開放
    Set myDic = Nothing
    Set Sht1 = Nothing
    Set Sht2 = Nothing

End Sub

マクロ実行前

マクロ実行後

重複がないデータを別シートに抽出します。

重複しないデータを別シート抽出（複数列）

以下のマクロを実行すると、2シート間で重複しないデータを別シート転記します。

Sub 重複がないデータを別シート抽出()

Dim myDic As Object
Dim myList As Variant
Dim i As Long
Dim j As Long
Dim Sht1 As Worksheet
Dim Sht2 As Worksheet

    Set myDic = CreateObject("Scripting.Dictionary")

    Set Sht1 = Sheets("Sheet1")
    Set Sht2 = Sheets("Sheet2")
    
    j = 1

    'A列,B列のデータを配列に格納
    myList = Sht1.Range("A2", Range("A" & Rows.Count). _
                     End(xlUp)).Resize(, 2).Value

    '連想配列にデータを格納
    For i = 1 To UBound(myList)

        '空欄じゃなければ
        If Not myList(i, 1) = Empty Then
            If Not myDic.exists(myList(i, 1) & myList(i, 2)) Then

                '重複しない値を取得
                myDic.Add Key:=myList(i, 1) & myList(i, 2), Item:=myList(i, 1) & myList(i, 2)
                
                '重複しない値を別シート転記
                Sht2.Cells(j, 1) = myList(i, 1)
                Sht2.Cells(j, 2) = myList(i, 2)
                j = j + 1
                
            End If
        End If
    Next i

    '開放
    Set myDic = Nothing
    Set Sht1 = Nothing
    Set Sht2 = Nothing

End Sub

マクロ実行前

マクロ実行後

A列＆B列の組み合わせで、重複していないリストを別シートへ抽出します。

 
 
この記事がお役に立ちますと幸いです。
 
・【エクセルマクロ】別シート転記を自動処理する方法まとめ
 

【エクセルマクロ】別シート転記(抽出)を自動化する：超便利20選

...

kirinote.com

2023.02.04