EXCEL VBA 重複データを削除・チェック・抽出・別シート（RemoveDuplicates メソッド）

EXCEL VBA 重複データを削除・チェック・抽出・別シート（RemoveDuplicates メソッド）

重複データを削除・複数条件・複数項目　（RemoveDuplicates メソッド）①

'
'******** AKIRA55.COM ******* https://akira55.com/jyuufuku02/
'
Sub 重複01()  '重複しているデータを削除
    
  Dim lRow As Long
  
  lRow = Cells(Rows.Count, "A").End(xlUp).Row 'データの最終行を取得

  Range("A1:D" & lRow).RemoveDuplicates Columns:=Array(1, 2, 3, 4), Header:=xlYes    '重複しているデータを削除

End Sub
'

重複データを削除・複数条件・複数項目・チェック　（RemoveDuplicates メソッド）②

'
'******** AKIRA55.COM ******* https://akira55.com/jyuufuku02/
'
Sub 重複02() '重複データを削除します。
    
  Dim I, lRow As Long
  Dim CK As Integer
  
  lRow = Cells(Rows.Count, "A").End(xlUp).Row 'データの最終行を取得
  
  For I = 2 To lRow  'データの最終行まで繰り返します。
  
        If WorksheetFunction.CountIfs(Range("A2:A" & lRow), Range("A" & I), Range("B2:B" & lRow), Range("B" & I), _
                Range("C2:C" & lRow), Range("C" & I), Range("D2:D" & lRow), Range("D" & I)) > 1 Then
                'CountIFs関数を使い、重複データを検索します。４つの項目とも同じデータが２つ以上ある場合は、２以上の数値を返します。
                
                Cells(I, "E") = "重複"  '重複データの場合は、チェック項目に「重複」と記入します。
                Cells(I, "E").Font.ColorIndex = 3 'チェック項目の「重複」を赤色にします。
                
        End If
  Next I
  
  CK = MsgBox("データを削除しますか？", vbYesNo + vbQuestion, "確認")  '重複データを削除するか判断します。
  
  If CK = vbYes Then
        Range("A1:E" & lRow).RemoveDuplicates Columns:=Array(1, 2, 3, 4), Header:=xlYes    '重複しているデータを削除
    Else
        MsgBox "キャンセルしました。"
  
  End If
  
End Sub
'

重複データを削除・複数条件・複数項目・チェック・別シート　（RemoveDuplicates メソッド）③

'
'******** AKIRA55.COM ******* https://akira55.com/jyuufuku02/
'
Sub 重複削除03() '別シートに転記して重複データを削除する

    Dim ws01, ws02 As Worksheet
    Dim I, lRow, mRow As Long
    Dim CK As Integer
    
    Set ws01 = Worksheets("DATA")
    Set ws02 = Worksheets("一覧")

    lRow = ws01.Cells(Rows.Count, "A").End(xlUp).Row 'シート「DATA」のA列最終行を取得
    mRow = ws02.Cells(Rows.Count, "A").End(xlUp).Row 'シート「一覧」のA列最終行を取得
    
    ws02.Cells.Clear   'シート「一覧」を削除します。
    
    For I = 2 To lRow  'シート「DATA」A列の最終行まで繰り返します。
  
        If WorksheetFunction.CountIfs(ws01.Range("A2:A" & lRow), ws01.Range("A" & I), ws01.Range("B2:B" & lRow), ws01.Range("B" & I), _
                ws01.Range("C2:C" & lRow), ws01.Range("C" & I), ws01.Range("D2:D" & lRow), ws01.Range("D" & I)) > 1 Then
                'CountIFs関数を使い、重複データを検索します。４つの項目とも同じデータが２つ以上ある場合は、２以上の数値を返します。
                
                ws01.Cells(I, "E") = "◎"  '重複データの場合は、重複フラグ項目に「◎」と記入します。
        End If
    Next I
  
    CK = MsgBox("データを削除しますか？", vbYesNo + vbQuestion, "確認")  '重複データを削除するか判断します。
  
    If CK = vbYes Then
    
            ws01.Range("A1:D" & lRow).Copy  'シート「DATA」のデータ範囲をコピーします。
            ws02.Range("A1").PasteSpecial Paste:=xlPasteAll  '選択したデータ範囲(シート「DATA」)を（シート「一覧」）へ張り付ける。
    
            mRow = ws02.Cells(Rows.Count, "A").End(xlUp).Row 'シート「一覧」のA列最終行を取得
            ws02.Range("A1:D" & mRow).RemoveDuplicates Columns:=Array(1, 2, 3, 4), Header:=xlYes    '重複しているデータを削除
            ws02.Activate 'シート「一覧」をアクティブにします。
        Else
            MsgBox "キャンセルしました。"
  
    End If
    
End Sub
'