【VBA】リストに重複しているデータを両方(3つ以上はすべて）削除する方法

エクセルの2000、2003のバージョンでは重複しているデータを無視するということができたらしいですが、それ以降のバージョンで重複しているデータをすべて削除する方法を工夫してみました。

方向としてはExcelでできる処理をVBAに乗せていくというわかりやすい方法で進めたいと思います。

【目次】

Excelで重複しているデータを判別する方法

A列のデータで重複するものがあるかどうかのチェック方法

=COUNTIF(A:A,A1)

A1セルの内容がA列に何個あるか数えるという処理方法です。これが式の答えが2以上であれば、重複しているという事になります。

2つの列データで確認したい場合

2つにデータがまたがっている場合には1列にしましょう。その時にどちらの列のデータなのかが分かるように隣に数字や記号を打っておくと良いと思います。

これで重複している2以上のデータを削除すればOKです。

VBAにしてみる

A列にデータがあるとしてVBAを書いてみます。

sub 重複両方削除()

'A列データの最終行を定義
Dim MaxrowA As Long
MaxrowA = Cells(Rows.Count, "A").End(xlUp).Row

'B列に判別式を記入
Range("B1").Formula = "=COUNTIF(A:A,A1)"

'B列の対応するセルに式をコピペ
Range("F4").Copy
Range(Cells(2, "B"), Cells(MaxrowA, "B")).Select
Selection.PasteSpecial Paste:=xlPasteAll

'A列とB列をソートし、B列を昇順にソート
    Columns("A:B").Select
    ActiveSheet.Sort.SortFields.Clear
    ActiveSheet.Sort.SortFields.Add Key:=Range("B:B"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveSheet.Sort
        .SetRange Range("A:B")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

’式を検索対象に含めないようにするため、B列を値に変換
Range("B:B").Copy
Range("B:B").PasteSpecial Paste:=xlPasteValues

'B列で2が最初に出てくる場所を特定・取得
Columns("B:B").Select
Selection.Find(What:="2", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, MatchByte:=False, SearchFormat:=False).Activate

Dim nowrow As Long
nowrow = ActiveCell.Row

'全て重複していた場合にセルが2番に指定されるので、カバーする

If nowrow = 2 Then
   nowrow = 1
End If

'2以上のデータを消す
Range(Cells(nowrow, "A"), Cells(MaxrowA, "B")).Clear

'B列を消す
Range("B:B")).Clear

End sub