キーが重複するデータを全て取り除くには?

Question 76.4   Previous Next
はじめまして。このサイトは大変参考になるので頻繁に訪れております。
QAで重複する行の削除の仕方が掲載されていました。シート内に同じ氏名が入力されたものが4行あったら重複分を削除して1行だけにするというものです。
そこで質問ですが、同じデータを全て削除することもできるでしょうか?
例えば、A列を氏名欄とした場合、ソートをかけて3行目と4行目、5行目の人が同姓同名であれば、重複だけでなく、3行目と4行目、5行目のデータは全削除し、その人が残らないようにしたいのです。
宜しくお願いします。 (Excel2000)
Answer   Copyright (C) 2005.11.9 永井善王
例えばソート後の状態が右図のようだとすると、3~5行目にある「Bさん」を 3行とも削除できればよいのですね。 他の項目に相違があるかどうかは無視してよいのですね。
FAQの[重複データをなくすには?]で紹介されているマクロでは、3行目は生かして4~5行目を削除するので
「Bさん」も1件だけは残ります

回答が長くなって分かりにくくなってもいけないので、ここでは、
元データのシート(Sheet1)には手を加えずに、削除後のデータを別シート(Sheet2)に作成する等、必要最小限にとどめます。
もしも、元シート自体から削除してしまいたい場合は、このマクロの末尾にSheet2をコピーしてSheet1に貼り付けるコードを追加すれば可能になります。なお、マクロの最初にSheet2をクリアしておくコード等、必要により追加してください。

では、Excelの一般機能を活用して、Excelらしく処理する方法を考えてみましょう。
なぜなら、すべてをプログラミングしようとすると、複雑な重複判定のロジックを考えないといけませんし、1行ずつ順に繰り返し処理するコーディングになってしまいがちです。結果、処理時間が掛かったりして、苦労が報われないことがあり得ますから。

処理の流れ
1. 作業用シートにするために、元データ(Sheet1)のコピーを作成する ([シートの移動またはコピー]機能にて)
2. 作業用シートをA列でソートする
3. 作業用シートの表の大きさを取得する (下端行と右端列)
4. 作業用シートの右端列の右の列 (下図ではC) に重複を判定する数式を設定する

  (注) C2セルのIF関数の意味 … もしA2とA3セルの値が等しければこのセルに1を、そうでなければ0を設定する
    C3セルの   〃     … もしA3とA4セルの値が等しければこのセルに1を、そうでない場合もしA3とA2セル
                     の値が等しければこのセルに1をそうでなければ0を設定する
5. オートフィルターで作業用シートの非重複データ (上図ではC列セルの値が0の行) を抽出する
6. 作業用シートのアクティブセル領域をコピーする (下図)

7. Sheet2に貼り付ける (下図)

8. Sheet2の数式の列を削除する (上図のC列)
9. 作業用シートを削除する

どうですか。上記の1.~9.の処理は、3.を除けば Excelの一般操作で出来ますね。 だったら、マクロは自動記録で出来るはずですからトライしてみましょう。
そして、自動記録したマクロは表の大きさ(行数等)が固定されてしまいますから、上記 3. のように大きさを取得するコードを追加して、柔構造のマクロに改良します。
下記のマクロは、そのようにして作成し整理したものです。参考にしてください。
Sub キーが重複するデータを全て取り除く()
    Worksheets("Sheet1").Copy Before:=Sheets(1) '作業用にSheet1のコピーを作成
    キー列 = "A1"                               'ソートする列(1行目)
    Range("A1").Sort Key1:=Range(キー列), Header:=xlGuess 'ソートする

    下端行 = Range("A" & Rows.Count).End(xlUp).Row '表の下端行番号を取得
    右端列 = Cells(1, Columns.Count).End(xlToLeft).Column '表の右端列番号を取得
    数式列 = 右端列 + 1                         '数式を設定する列番号
    数式1 = "=IF(A2=A3,1,0)"                    '最初の行に設定する数式
    数式2 = "=IF(A3=A4,1,IF(A3=A2,1,0))"        '次行以下に設定する数式
    Cells(2, 数式列).Formula = 数式1            '最初の行に数式を設定
    Range(Cells(3, 数式列), Cells(下端行, 数式列)).Formula = 数式2 '次行以下に設定

    Range("A1").Select                          '左上角のセルを選択
    Selection.AutoFilter Field:=数式列, Criteria1:="0"
                                                'オートフィルターする(数式列=0)
    Selection.CurrentRegion.Copy                'アクティブセル領域をコピー

    With Worksheets("Sheet2")                   'Sheet2に対して
        .Range("A1").PasteSpecial Paste:=xlPasteAll 'すべて貼り付け
        .Columns(数式列).Delete Shift:=xlToLeft '数式列を削除
    End With

    Application.DisplayAlerts = False           '注意メッセージを表示しない
    ActiveSheet.Delete                          '作業用シートを削除
End Sub
では、根気よくチャレンジして、結果をお知らせください。お待ちしています。

関連ページ
 ・
範囲を検出して選択
 ・
数式をオートフィルしたように設定する
 ・
オートフィルターの基本制御
 ・
重複データをなくすには
 ・
キーが重複するデータを取り除くには

Excel VBA Macro