同番号を削除したい

質問

VBA初心者です。教えて下さい。
A1からA100まで番号が振ってあり同じ値があった場合、下の行を削除したいと考えてます。
下を実行すると1つだけ同じ値があった場合はいいのですが何個も同じ値があった場合には削除できません。
どうしたらよいでしょうか？

Dim gyo As Integer
For gyo = 1 To 100
If Cells(gyo, 1).Value = Cells(gyo + 1, 1) Then Range(Cells(gyo + 1, 1), Cells(gyo + 1, 3)).ClearContents
End If
Next gyo

回答No.2

ka_na_de · ベストアンサー

VBAの勉強をしているということですか？
だとすると、hohonikuさんのコードをベースに修正すると、
こんな感じになります。

Sub test1()
　Dim gyo As Integer
　For gyo = 100 To 2 Step -1
　　If Cells(gyo, 1).Value = Cells(gyo - 1, 1).Value Then
　　　Range(Cells(gyo, 1), Cells(gyo, 3)).ClearContents
　　End If
　Next gyo
End Sub

ただし、これでは、行数が変わるたびにコードを変更しなければなりませんし、
同一データが隣接していない場合は削除することができません。
paopao01さんの回答は、これらの問題点を事前に解決した例です。
なおかつ、セルの内容削除ではなく、質問タイトル通りに行削除するように変更してあります。
おせっかいな補足説明でした。

お礼

そうなんです。やっと初歩的な本を1冊読み終えたとこです。
事前に並替え処理を行う事で希望通りの動きをしてくれました。
[Step]の処理などまだ理解できない部分もありますのでこれから勉強していきたいと 思います。

回答No.1

noname#97729

これで、どうですか。

Sub test()

'Ａ列の最終行収得
lastrow = Range("A65536").End(xlUp).Row

'最後の位置から重複行の削除処理
For i = lastrow To 2 Step -1

temp = Cells(i, 1).Value

'目的のセル値がA列に2つ以上あるときセルの削除
If Application.WorksheetFunction.CountIf(Range("A1:A" & lastrow), temp) > 1 Then
'セルの行の削除
Cells(i, 1).EntireRow.Delete Shift:=xlUp

End If

Next i

End Sub

お礼

早い解答ありがとうございます。
実行すると「定義がされてません」や「型が合いません」とエラーを返されてしまいます。まだまだ勉強不足みたいです。