Excel

【Excel】VBAマクロで重複をチェックし重複データをまとめる（抽出：カウント）方法【UniqueDuplicates】

 
当サイトでは記事内に広告を含みます
いつも記事を読んでいただきありがとうございます！！！ これからもお役に立てる各情報を発信していきますので、今後ともよろしくお願いします(^^)/

この記事では、Excel VBAを用いて、重複するデータのみを抽出し、さらにその中からユニークなデータをまとめる方法について解説します。

ポイントとしては、独自のロジックとExcel VBAの組み込み関数を組み合わせることです。初心者にも理解しやすいように、変数名を独特の名称にしています。

実際の利用時には、一般的に英語表記の適切な変数名に変更してください。

それでは、具体的な手順を見ていきましょう！

ロで重複をチェックし重複データのみをまとめる（抽出：1列のみに着目）方法【Dictionary】

それではまず、データの中から重複している項目を特定し、それらを別の範囲にコピーする方法について解説していきます。

ここでは`Dictionary`オブジェクトを使い、データを効率よく処理します。


Sub CopyDuplicatesToAnotherRange()
    ' 辞書オブジェクトの初期化
    Dim dict As Object
    Set dict = CreateObject("Scripting.Dictionary")
    
    ' データ範囲の指定
    Dim dataRange As Range
    Set dataRange = ThisWorkbook.Sheets("Sheet1").Range("A1:A100")
    Dim cell As Range
    
    ' 各セルの値をチェックして辞書にカウント
    For Each cell In dataRange
        If Not cell.Value = "" Then
            If dict.Exists(cell.Value) Then
                dict(cell.Value) = dict(cell.Value) + 1
            Else
                dict(cell.Value) = 1
            End If
        End If
    Next cell
    
    ' 重複データを別の範囲にコピー
    Dim i As Long
    i = 1 ' コピー開始位置
    For Each Key In dict.Keys
        If dict(Key) > 1 Then
            ThisWorkbook.Sheets("Sheet1").Cells(i, "B").Value = Key
            i = i + 1
        End If
    Next Key
End Sub

Alt + F11にてVBE画面を開いて、上記コードをコピペしましょう。

コードの実行はAlt+F8を押し、マクロ選択画面で`CopyDuplicatesToAnotherRange`関数を実行します。

このマクロは、指定した範囲内で重複しているデータを別の範囲にコピーします。

重複データを抽出する範囲やコピー先は、コード内の`dataRange`や`i`変数を適宜変更してください。

 

VBAマクロで重複をチェックし重複データのみをまとめる（抽出：複数列にOR条件）方法【RemoveDuplicates】

続いては、コピーした重複データからユニークなデータのみを残す方法について解説していきます。

Excel VBAの`RemoveDuplicates`メソッドを活用して、データを精査します。


Sub LeaveUniqueDuplicates()
    ' データがコピーされた範囲の指定
    Dim duplicatesRange As Range
    Set duplicatesRange = ThisWorkbook.Sheets("Sheet1").Range("B1:B" & ThisWorkbook.Sheets("Sheet1").Cells(Rows.Count, "B").End(xlUp).Row)
    
    ' RemoveDuplicatesメソッドを使ってユニークなデータのみを残す
    duplicatesRange.RemoveDuplicates Columns:=1, Header:=xlNo
End Sub

Alt + F11でVBE画面を開いて、上記コードをコピペしてください。

実行するにはAlt+F8を押し、`LeaveUniqueDuplicates`関数を実行します。この関数は、コピーされた重複データの中からユニークな項目のみを残し、重複を削除します。

重複データがコピーされた範囲は、`duplicatesRange`変数で指定します。

 

 VBAマクロで配列の重複を抽出し重複データのみをまとめたデータリストを作成する方法【FinalList】

最後に、ユニークな重複データを抽出して、新しいリストを作成する方法を見ていきましょう。

これにより、データの中から重複するユニークな項目のみを一覧できます。


Sub CreateUniqueDuplicatesList()
    ' ユニークな重複データがある範囲の指定
    Dim uniqueDuplicatesRange As Range
    Set uniqueDuplicatesRange = ThisWorkbook.Sheets("Sheet1").Range("B1:B" & ThisWorkbook.Sheets("Sheet1").Cells(Rows.Count, "B").End(xlUp).Row)
    
    ' 新しいシートを作成し、ユニークな重複データをコピー
    Dim newSheet As Worksheet
    Set newSheet = ThisWorkbook.Worksheets.Add
    newSheet.Name = "UniqueDuplicatesList"
    uniqueDuplicatesRange.Copy Destination:=newSheet.Range("A1")
End Sub

Alt + F11でVBE画面を開いて、上記のコードをコピペします。

Alt+F8を押し、`CreateUniqueDuplicatesList`関数を実行すると、ユニークな重複データが新しいシートにリストアップされます。

この関数は、コピーされたユニークな重複データを新しいシートに転記し、整理されたリストを作成します。

 

まとめ　VBAマクロで重複データをまとめる（抽出：カウント）方法【UniqueDuplicatesなど】

これで、重複データのみを残し、その中からユニークなデータのみを抽出する手順が完了します。

この方法を活用して、より業務を効率化させていきましょう。

RELATED POST