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

Question 76.3 値の操作 Previous Next
同列に同じ名が連続して表記されているものを、先頭の表記だけ残してグループ化し、そのあとの表記は削除したいのですが、何か便利な方法は無いでしょうか?
Excel2002を使っています。
Answer   Copyright (C) 2005.11.4 永井善王
拙著「ExcelVBAマクロ 500連発」の読者さんのようで、ありがとうございます。
キーが重複するデータを取り除きたいのですか。
例えば右図で、A例がキーとすると、4、7~8、11行目を削除すればよいのですね。

「アドバンスフィルタで重複を取り除いて抽出する」というコードが近著(※)にありますから、それを活用してマクロを組んでみましょう。
 ※ ExcelVBAマクロ組み方講座 プロの定番・裏技・合わせ技[編] 137ページ

処理の流れ
1. アドバンスフィルタで名前(A列)が重複している行を除去して抽出する
2. 抽出できたシートのアクティブセル領域をコピーする
3. 一旦、別シートに貼り付ける
4. 元シートのすべてのデータを表示する(アドバンスフィルタを解除)
5. 元シートのすべてのセルをすべてクリアする
6. 別シートから元シートへコピー貼り付けする

なお、元シートがキー順になっていない場合は、1. の前に並べ替えのコードを追加します。 また、元シートを変更したくない(結果を別シートに作成する)場合は、5. と 6. は不要です。
マクロは下記のとおりですが、元シート名、別シート名、キーとなる列名は簡単に変更できます。
Sub キーが重複するデータを取り除く()
    リスト = "Sheet1"                           '処理するシート名
    列 = 1                                      '名前の列
    一時 = "Sheet2"                             '一時的に使用するシート名
    With Worksheets(リスト)                     '処理するシートの
        .Columns(列).AdvancedFilter action:=xlFilterInPlace, unique:=True
                                                'アドバンスフィルタで重複を除去する
        .Range("A1").CurrentRegion.Copy         'アクティブセル領域をコピー
        Worksheets(一時).Range("A1").PasteSpecial Paste:=xlPasteAll
                                                '一時シートに貼り付け
        .ShowAllData                            'すべてのデータを表示
        .Cells.Clear                            'すべてのセルをすべてクリア
        Worksheets(一時).Cells.Copy             '一時シートのすべてのセルをコピー
        .Range("A1").PasteSpecial Paste:=xlPasteAll 'すべて貼り付け
        Worksheets(一時).Cells.Clear
    End With
End Sub

左図がこのマクロの実行結果です。
サンプルブック YNxv98641_AdvancedFilter.xls (29KB)  ダウンロードはここをクリック
※ 一旦、ブックをハードディスクに保存し、開き直してから実行してください。
サンプルが上手く動作しましたら、あなたのデータで試してみて、その結果をご連絡ください。
お待ちしています。


 

Excel VBA Macro