あるシートがあります。
Ｈ列に英数字半角の顧客ＩＤが入っています。（H1は見出しです）
★それらのＩＤで重複していたら、それらの行ごとすべて削除するというマクロをお願いしたいのです。
例
H
顧客ID
aaa
bbb
ccc
ddd
ccc
eee
↑の例でしたら、cccが重複していますので、cccが入っている行を２行まとめて削除して、
上につめていただきたいです。重複しているデータは１つに限らず、何個も重複していたり、
重複がまったくないときもあります。
行はどこまで続くかは不明ですので、H列の欄が空白になった時点でマクロを止めるようにしてください。
Ｈ列は変わることがありますので、”Ｈ”を入れておいていただけますでしょうか。
よろしくお願いいたします。
No.3
1314
393
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
No.1
10
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
他の方の回答も付いていましたね。行削除に直したので、一応貼っておきます。
ｘと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
ありがとうございました！ご丁寧に感謝します。動作いたしました！何度もすみません！！
No.2
4816
10pt
マクロでないとダメですか？
重複がある列（質問だとH列）全体を選択した状態で、メニューの「データ」＞「フィルタ」でフィルタをかけて、「データ」＞「詳細設定」で詳細設定画面を開くと、下に「重複するレコードは無視する」のチェックボックスがあります。
こちらをチェックを入れると、重複するデータのあるレコードが非表示になるので、そのままつかうか、その状態で全体を選択して、別シートにコピーすれば、似たような状態になると思います。
ありがとうございます。その方法は知っているのですが、自動処理したいため、お願いしております。回答ありがとうございます。
No.3
1314393
ここでベストアンサー
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
セルの含まれる行を指定する場合は、EntireRow プロパティを使用します。
1
1
1
1
74
74
セルの含まれる行を指定する場合は、EntireRow プロパティを使用します。
2012/12/11 19:48:56