今回は、内容が同じ（被ってしまった）行があった場合に、1行だけ残して、その他は全て削除するマクロです。
下の画像ぐらいの量であれば、手作業で削除することも可能ですが、それでも消し間違いなど細心の注意を払わなければなりません。
ということで、VBAでプログラムを書いてみました。
数千行、数万行にも対応しています。
概要
手順としては、
1. A1の型番に対して、Sortで並べ替え
2. For構文で、最終行から1行ずつ、上の行の内容と同じかチェック
3. 同じだった場合、削除
4. 2と3を繰り返し
実行前
↓
実行後
コード【VBAマクロ】
- Sub 重複した行の削除()
- Dim i As Long
- Application.ScreenUpdating = False
- Range("A1").CurrentRegion.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlYes
- For i = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
- If Cells(i, 1) = Cells(i - 1, 1) Then
- Application.Rows(i).Delete
- End If
- Next i
- Application.ScreenUpdating = True
- End Sub
コード【VBAマクロ】の解説
2.
行数をi、宣言しています。
3.
削除の度に画面が更新されると、重くなる（作業が遅くなる）ので、画面更新をオフにしています。
10行目の全ての作業が終わった後に、画面更新をオンにして、元の状態に戻しています。
4.
Sortによる並べ替えの部分です。
A1を選んだ後に、CurrentReagionで表の全ての範囲を選択しています。
CurrentReagionで、A1からC17までの範囲を選んだことになります。
その後、Sortで並べ替え操作を指示しています。
Key1の引数として、並べ替えを行いたい項目を入れます。今回はA1の型番情報です。
次に、Order1の引数として、並べ替える方法を昇順（xlAscending）と指定しています。
そして最後に、見出しがあるので、HeaderをxlYesとします。
※A1以外でSortしたい場合は、RangeのA1を他のB1などに変更すれば出来ます。
5-9.
For Next構文で、1行ずつチェックしていく部分です。
最終行→2行目まで、下から上にループをまわしています。
削除していくループの場合、下→上の方向で行う必要があります。
if文で、A列のi行目の内容と、A列のi-1行目（ひとつ上）の内容が同じ場合、i行目を削除します。
※A列以外をチェックする場合は、Cellsの列部分の1を、2（B列）、3（C列）などに変更します。
今回のコードでは、Sortで並べ替えてから、上の行と同じ内容か比較して、同じ場合に削除する方法を取りました。
そうすることで、1行分だけ残る仕様にしています。
他の方法だと、別でマスタを作って、VLOOKUPで探して、該当した行を変数に組み込む方法でも出来そうだなと思いました。
