ExcelVBA 行毎の重複検索と削除

質問

ExcelVBA　行毎の重複検索と削除

画像を確認いただきたいのですが、
赤くなっているところが、一行毎の重複セルとなりますが、
これを自動的に検索して削除し、左詰めを行う、
というVBAコードを知りたいです

なにぶん初心者なもので、できれば一つ一つの動きが分かるような
コメント付きで頂けるとありがたいです。

お手数ですが皆様よろしくお願いします。

回答No.2

tom04 · ベストアンサー

こんばんは！
一例です。

データは2行目からあるとします。
余計なお世話かもしれませんが、空白セルも一緒に削除するようにしてみました。

↓のコードを操作したいSheet見出し上で右クリック　→　コードの表示　を選択し、表示された画面にコピー＆ペーストしてマクロを実行してみてください。

尚、一旦マクロを実行すると元に戻せませんので、別Sheetにコピー＆ペーストしてマクロを試してみてください。

Sub test()
Dim i, j As Long
For i = 2 To ActiveSheet.UsedRange.Rows.Count
For j = Cells(i, Columns.Count).End(xlToLeft).Column To 2 Step -1
If Cells(i, j) = "" Or WorksheetFunction.CountIf(Range(Cells(i, 2), Cells(i, j)), Cells(i, j)) > 1 Then
Cells(i, j).Delete (xlToLeft)
End If
Next j
Next i
End Sub

以上、参考になれば良いのですが・・・m(__)m

お礼

tom04様

ありがとうございます。
解決しました。

ただ、Delete (xlToLeft)の処理があまりにもメモリを食うため、clearに変更しました。
空白セルの削除まで組み込んでいただき、ありがとうございました。

回答No.1

emuancha

こんにちは。

そんなに難しいコードではありませんよ。と言っても質問がかなり曖昧なのでコードは，示せません。

まず，マクロ記録をオンにして，手作業でやりたいことを行い，マクロ記録をオフにして，VBAのコードを見たら如何でしょうか？　何もないところから，コーディングするより，かなり効果的になると思います。

補足

質問が曖昧なようで失礼しました。
・”左側のセルと同じ値のセル”の条件で検索
・条件にhitしたセルを削除して左詰め

これでいいでしょうか。

なお、マクロの記録機能を使いたいのはやまやまですが、上記の条件の
設定方法が分からないので操作できない為、質問しています。

引き続き皆様よろしくお願いします。