エクセルマクロで重複データをすべて自動削除することを教えてください。


あるシートがあります。
H列に英数字半角の顧客IDが入っています。(H1は見出しです)

★それらのIDで重複していたら、それらの行ごとすべて削除するというマクロをお願いしたいのです。


H
顧客ID
aaa
bbb
ccc
ddd
ccc
eee


↑の例でしたら、cccが重複していますので、cccが入っている行を2行まとめて削除して、
上につめていただきたいです。重複しているデータは1つに限らず、何個も重複していたり、
重複がまったくないときもあります。

行はどこまで続くかは不明ですので、H列の欄が空白になった時点でマクロを止めるようにしてください。


H列は変わることがありますので、”H”を入れておいていただけますでしょうか。

よろしくお願いいたします。

回答の条件
  • 1人5回まで
  • 13歳以上
  • 登録:2012/12/11 13:06:12
  • 終了:2012/12/11 21:02:38

ベストアンサー

id:Mook No.3

Mook回答回数1312ベストアンサー獲得回数3912012/12/11 19:46:37

ポイント100pt

行全体を消すということなので、下記でどうでしょうか。
重なっているデータの行をすべて消すという説明なので、
H列がAA,BB,CC,AA,BB,AA だと CC の行だけになる処理です。

Option Explicit

Const ID_ROW = "H"
Sub DeleteDuplicatedRows()
    Dim objDic
    Set objDic = CreateObject("Scripting.Dictionary")

    Dim r As Long
    r = 2
    Do While Cells(r, ID_ROW).Value <> ""
        objDic(Cells(r, ID_ROW).Value) = objDic(Cells(r, ID_ROW).Value) + 1
        r = r + 1
    Loop
    
    Application.ScreenUpdating = False
    Do While r >= 2
        If objDic(Cells(r, ID_ROW).Value) >= 2 Then Cells(r, ID_ROW).EntireRow.Delete
        r = r - 1
    Loop
    Application.ScreenUpdating = True
End Sub
id:Mook

セルの含まれる行を指定する場合は、EntireRow プロパティを使用します。

2012/12/11 19:48:56

その他の回答(2件)

id:slow_learner No.1

slow_learner回答回数1ベストアンサー獲得回数02012/12/11 17:04:03

ポイント100pt

xが列数、yが開始データの行数です。
比較元の行も削除するようにしています。

Sub hatena()
x = 1
y = 1
Do While Cells(y, x).Value <> ""
id1 = Cells(y, x).Value
z = y + 1
flag = 0
Do While Cells(z, x).Value <> ""
If Cells(y, x).Value = Cells(z, x).Value Then
Cells(z, x).Delete Shift:=xlUp
flag = 1
Else
z = z + 1
End If
Loop
If flag = 1 Then
Cells(y, x).Delete Shift:=xlUp
Else
y = y + 1
End If
Loop
End Sub

他1件のコメントを見る
id:slow_learner

他の方の回答も付いていましたね。行削除に直したので、一応貼っておきます。
xとyの使い方はさっきと一緒ですが、いちいち書き換えるのも大変なので、
マクロ実行時点の選択セルの行と列を取得するようにしておきました。

Sub hatena()
x = Selection.Column
y = Selection.Row
Do While Cells(y, x).Value <> ""
id1 = Cells(y, x).Value
z = y + 1
flag = 0
Do While Cells(z, x).Value <> ""
If Cells(y, x).Value = Cells(z, x).Value Then
Rows(z).Delete Shift:=xlUp
flag = 1
Else
z = z + 1
End If
Loop
If flag = 1 Then
Rows(y).Delete Shift:=xlUp
Else
y = y + 1
End If
Loop
End Sub

2012/12/11 20:17:50
id:naranara19

ありがとうございました!ご丁寧に感謝します。動作いたしました!何度もすみません!!

2012/12/11 21:01:32
id:kseikaku No.2

kseikaku回答回数48ベストアンサー獲得回数162012/12/11 17:48:45

ポイント10pt

マクロでないとダメですか?

重複がある列(質問だとH列)全体を選択した状態で、メニューの「データ」>「フィルタ」でフィルタをかけて、「データ」>「詳細設定」で詳細設定画面を開くと、下に「重複するレコードは無視する」のチェックボックスがあります。
こちらをチェックを入れると、重複するデータのあるレコードが非表示になるので、そのままつかうか、その状態で全体を選択して、別シートにコピーすれば、似たような状態になると思います。

id:naranara19

ありがとうございます。その方法は知っているのですが、自動処理したいため、お願いしております。回答ありがとうございます。

2012/12/11 19:42:19
id:Mook No.3

Mook回答回数1312ベストアンサー獲得回数3912012/12/11 19:46:37ここでベストアンサー

ポイント100pt

行全体を消すということなので、下記でどうでしょうか。
重なっているデータの行をすべて消すという説明なので、
H列がAA,BB,CC,AA,BB,AA だと CC の行だけになる処理です。

Option Explicit

Const ID_ROW = "H"
Sub DeleteDuplicatedRows()
    Dim objDic
    Set objDic = CreateObject("Scripting.Dictionary")

    Dim r As Long
    r = 2
    Do While Cells(r, ID_ROW).Value <> ""
        objDic(Cells(r, ID_ROW).Value) = objDic(Cells(r, ID_ROW).Value) + 1
        r = r + 1
    Loop
    
    Application.ScreenUpdating = False
    Do While r >= 2
        If objDic(Cells(r, ID_ROW).Value) >= 2 Then Cells(r, ID_ROW).EntireRow.Delete
        r = r - 1
    Loop
    Application.ScreenUpdating = True
End Sub
id:Mook

セルの含まれる行を指定する場合は、EntireRow プロパティを使用します。

2012/12/11 19:48:56

コメントはまだありません

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません