不要行を削除して上に詰めていく

質問

エクセルマクロでA～D列の４列につながる４行一組が繰り返される同じパターンの色帯でA列の「生」という一文字の下に無色がなければ４行ごと削除していって上に詰めていってください。

回答No.1

kkkkkm · ベストアンサー

以下で試してみてください。

Sub Test()
Dim i As Long
Dim LastRow As Long

LastRow = Cells(Rows.Count, "A").End(xlUp).Row

For i = LastRow To 1 Step -1
If Cells(i, "A").Value = "生" And _
Cells(i, "A").Offset(1, 0).DisplayFormat.Interior.ColorIndex <> xlNone Then
Range(Rows(i), Rows(i + 3)).Delete
End If
Next

End Sub

お礼

動作完全完璧にOKでした。
ありがとうございました。