【Excel】VBAマクロで同じ値があったら別シートに転記・削除（重複を）する方法【Find, Copy, Delete】

この記事では、VBAマクロで同じ値があったら別シートに転記・削除（重複を）する方法【Find, Copy, Delete】について解説していきます。

ポイントとしては`Find`、`Copy`、`Delete`メソッドを使用することです。

初心者でもわかりやすいように、少々変わった日本語のローマ字風表記の変数名を用いて説明します。

それでは詳しく見ていきましょう！

VBAマクロで同じ値があったら別シートに全て転記する方法

それではまず、B列の数値で重複しているデータを別シートに転記する方法について解説していきます。

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


Sub aaaaacopyRowsaaaaa()
    Dim aaaaaworksheetSourceaaaaa As Worksheet, aaaaaworksheetTargetaaaaa As Worksheet
    Dim aaaaalastRowaaaaa As Long, aaaaaiRowaaaaa As Long
    Dim aaaaadictionaryaaaaa As Object
    Set aaaaadictionaryaaaaa = CreateObject("Scripting.Dictionary")
    Set aaaaaworksheetSourceaaaaa = ThisWorkbook.Sheets("Source")
    Set aaaaaworksheetTargetaaaaa = ThisWorkbook.Sheets("Target")
    
    aaaaalastRowaaaaa = aaaaaworksheetSourceaaaaa.Cells(aaaaaworksheetSourceaaaaa.Rows.Count, "B").End(xlUp).Row
    
    For aaaaaiRowaaaaa = 1 To aaaaalastRowaaaaa
        If Not aaaaadictionaryaaaaa.Exists(aaaaaworksheetSourceaaaaa.Cells(aaaaaiRowaaaaa, 2).Value) Then
            aaaaadictionaryaaaaa.Add aaaaaworksheetSourceaaaaa.Cells(aaaaaiRowaaaaa, 2).Value, Nothing
        Else
            aaaaaworksheetSourceaaaaa.Rows(aaaaaiRowaaaaa).Copy Destination:=aaaaaworksheetTargetaaaaa.Rows(aaaaaworksheetTargetaaaaa.Cells(aaaaaworksheetTargetaaaaa.Rows.Count, "B").End(xlUp).Row + 1)
        End If
    Next aaaaaiRowaaaaa
End Sub

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

このコードは、SourceシートのB列を確認し、重複している行をTargetシートに転記します。`Dictionary`オブジェクトを使用して、重複チェックを行い、転記を行います。

VBAマクロで同じ値があったら削除し先頭行だけ重複を残す方法

続いては、B列の数値で重複している行を削除し、最初の行のみ残す方法について解説していきます。

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


Sub aaaaadeleteDuplicatesaaaaa()
    Dim aaaaaworksheetaaaaa As Worksheet
    Dim aaaaalastRowaaaaa As Long, aaaaaiRowaaaaa As Long
    Dim aaaaadictionaryaaaaa As Object
    Set aaaaadictionaryaaaaa = CreateObject("Scripting.Dictionary")
    Set aaaaaworksheetaaaaa = ThisWorkbook.Sheets("Source")
    
    aaaaalastRowaaaaa = aaaaaworksheetaaaaa.Cells(aaaaaworksheetaaaaa.Rows.Count, "B").End(xlUp).Row
    
    For aaaaaiRowaaaaa = aaaaalastRowaaaaa To

 1 Step -1
        If Not aaaaadictionaryaaaaa.Exists(aaaaaworksheetaaaaa.Cells(aaaaaiRowaaaaa, 2).Value) Then
            aaaaadictionaryaaaaa.Add aaaaaworksheetaaaaa.Cells(aaaaaiRowaaaaa, 2).Value, Nothing
        Else
            aaaaaworksheetaaaaa.Rows(aaaaaiRowaaaaa).Delete
        End If
    Next aaaaaiRowaaaaa
End Sub

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

このコードでは、B列で重複している行を削除し、最初に見つけた行のみを残します。

ループは最終行から開始し、重複が検出された場合、その行を削除します。