【VBA】条件分岐で行の削除方法

Question

エクセル2013でVBAを作成していますが、どうやって作成すればいいか分からないので質問させてください。
以下のようなデータがあったときに太字の部分を削除するVBAを作るにはどうしたらよいでしょうか。
かなりのデータ量があるので時間のかからない処理ができる方法を探しております。

削除の条件としては以下条件すべてに当てはまった場合になります。
①A列～B列が同じ値
②①の条件かつ、D列が確定の次に未確定がある
③C列が確定日と同じ、もしくは確定日より前の場合

よろしくお願いいたします。

A列　　 B列　　 C列　　　    　D列
A100	1100	2020/10/25	確定
B100	1100	2020/10/26	確定
**B100	1100	2020/10/26	未確定**
A101	1101	2020/10/25	確定
**A101	1101	2020/10/25	未確定**
A101	2201	2020/10/25	確定
A101	2201	2020/10/28	未確定
A201	2200	2020/10/28	確定
**A201	2200	2020/10/27	未確定**
B201	1120	2020/10/25	未確定
B201	1120	2020/10/27	未確定


↓

A列　　 B列　　 C列　　　    　D列
A100	1100	2020/10/25	確定
B100	1100	2020/10/26	確定
A101	1101	2020/10/25	確定
A101	2201	2020/10/25	確定
A101	2201	2020/10/28	未確定
A201	2200	2020/10/28	確定
B201	1120	2020/10/25	未確定
B201	1120	2020/10/27	未確定

Accepted Answer

作業列にF列を使います。
削除対象となった行のF列に「削除」の文字が設定されます。
また、その行が正しいかどうかを比較する為に削除対象行の1行前に「元データ」の文字を設定します。
フィルターで「削除」と「元データ」のみを表示し、正しいかどうか目視してチェックしてください。
OKなら「削除」のみを表示し、それらの行を全て選択し、手作業で削除してください。
（慣れてきて、元データとの比較が不要なら、「元データ」の文字を設定している個所をコメントアウトしてください。そうすれば、いきなり、削除のみを選択して、削除することもできます）
```VBA
Option Explicit
Public Sub 削除行抽出()
    Dim sh1 As Worksheet
    Dim wrow As Long
    Dim maxrow As Long
    Set sh1 = ActiveSheet
    maxrow = sh1.Cells(Rows.Count, "A").End(xlUp).Row  'Sheet1 A列最大行
    sh1.Columns("F").Clear
    For wrow = 3 To maxrow
        If sh1.Cells(wrow, "D").Value = "未確定" Then
            If sh1.Cells(wrow - 1, "D").Value = "確定" Then
                If sh1.Cells(wrow, "A").Value = sh1.Cells(wrow - 1, "A").Value Then
                    If sh1.Cells(wrow, "B").Value = sh1.Cells(wrow - 1, "B").Value Then
                        If sh1.Cells(wrow, "C").Value <= sh1.Cells(wrow - 1, "C").Value Then
                            sh1.Cells(wrow - 1, "F").Value = "元データ"
                            sh1.Cells(wrow, "F").Value = "削除"
                        End If
                    End If
                End If
            End If
        End If
    Next
End Sub

```

Answer

1行目は見出しでデータは2行目からとして、F列を作業列とします。

F3セルに下記の式を記述します。

```excel
=IF(AND(A2=A3,B2=B3,D3="未確定",D2="確定",C3<=C2),1,0)
```
データの最後の行までフィルダウンします。

フィルターでF列で 1 のみ選択するようにします。
データ範囲を選択して削除します。

これで目的のデータが削除できると思います。

これをマクロの記録でVBA化して、それを元に書き換えるといいでしょう。

念のためにバックアップを取ってから作業をしてください。

---

作業列とオートフィルターを使って削除する場合のコード例

```vba
Sub Sample1()
    Application.ScreenUpdating = False
    
    Dim tbl As Range
    Set tbl = Range("A1").CurrentRegion
    Set tbl = tbl.Resize(, tbl.Columns.Count + 1) '作業列追加
    
    Dim workCol As Range '作業列の式を設定する範囲
    Set workCol = tbl.Columns(tbl.Columns.Count).Offset(2).Resize(tbl.Rows.Count - 2, 1)
    workCol.Formula = "=IF(AND(A2=A3,B2=B3,D3=""未確定"",D2=""確定"",C3<=C2),1,0)"

    tbl.AutoFilter Field:=6, Criteria1:="1"
    tbl.Offset(1).EntireRow.Delete
    tbl.AutoFilter
    workCol.Clear

    Application.ScreenUpdating = True
End Sub
```

Answer

オートフィルターでそのデータを抽出できませんか？
できたら、その行を削除するだけです。
フィルターモード中は、非表示セルの操作は無効になりますので、
何も考えずに表示された範囲をずらずらドラッグで選択し削除していいと思います。

まずは、手動でやってみて、その操作をマクロの記録という機能でコードに
翻訳してもらいコードを探るところから始めてみてください。

> ②①の条件かつ、D列が確定の次に未確定がある
あぁ、これがオートフィルターでは抽出できませんね。

結局、A列、B列、C列が同じものがあるとき、
未確定を削除して確定を残したいということなら、
「重複の削除」の機能で削除できそうですか？

関連した質問