VBA100本ノック 10本目:行の削除

こちらで公開されている、100本ノックに挑戦。
www.excel-ubara.com
素晴らしい教材を公開いただき、ありがとうございます。

上記リンク先から、問題文を転載。
f:id:Infoment:20220115215838p:plain

行の削除といえば、下からがセオリー。上から消すと、消すたびに
行数がずれていくから。

Sub VBA_100Knock_010()
    Dim i As Long
        For i = 16 To 2 Step -1
            If Cells(i, 3) = vbNullString And _
              (Cells(i, 4) Like "*削除*" Or _
               Cells(i, 4) Like "*不要*") Then
                Rows(i).Delete
            End If
        Next
End Sub

まとめて消すなら削除対象のセルを、Unionメソッドで結合してもいい。

Sub VBA_100Knock_010()
    Dim i As Long
    Dim TargetRange As Range
        For i = 2 To 16
            If Cells(i, 3) = vbNullString And _
              (Cells(i, 4) Like "*削除*" Or _
               Cells(i, 4) Like "*不要*") Then
                If TargetRange Is Nothing Then
                    Set TargetRange = Cells(i, 3)
                Else
                    Set TargetRange = Union(TargetRange, Cells(i, 3))
                End If
            End If
        Next
        
        If Not TargetRange Is Nothing Then
            TargetRange.EntireRow.Delete
        End If
End Sub

Like演算子ではなく正規表現を使うと、こんな感じか。

Sub VBA_100Knock_010()
    Dim i As Long
    Dim TargetRange As Range
    ' 正規表現。
    Dim myReg As Object
    Set myReg = CreateObject("VBScript.RegExp")
        myReg.Pattern = "(削除|不要)"
        For i = 2 To 16
            If Cells(i, 3) = vbNullString And _
               myReg.Test(Cells(i, 4)) Then
                If TargetRange Is Nothing Then
                    Set TargetRange = Cells(i, 3)
                Else
                    Set TargetRange = Union(TargetRange, Cells(i, 3))
                End If
            End If
        Next
        
        If Not TargetRange Is Nothing Then
            TargetRange.EntireRow.Delete
        End If
End Sub

どんどん行数が増えていく。良し悪し有りかな。

解答を実行した結果がこちら。
f:id:Infoment:20220115222354g:plain

※冒頭リンク先の解答例および解説も、ぜひご一読ください。

参考まで。