こんにちは。
２パターン作ってみました。
test1 はH10以降のＨ列の中で「日本」を探して
そのセル以降のデータ行を削除します。
test2 は並び替えなしに、Ｈ10以降のＨ列に「削除」の文字を
探して、見つかった全ての行を複数選択して、最後にまとめて
削除します。 Unionを使った例です。
Sub test()
Dim c As Object
Dim myKey As String
Dim myRange As Range
Dim myFirstCell As Range
Dim myLastCell As Range
Set myFirstCell = Range("H10")
myKey = "日本"
Set myLastCell = Cells(Rows.Count, myFirstCell.Column).End(xlUp)
Set myRange = Range(myFirstCell, myLastCell)
Set c = myRange.Find(What:=myKey, LookIn:=xlValues, lookat:=xlPart, _
SearchOrder:=xlByColumns, MatchByte:=False)
If Not c Is Nothing Then
Range(c, myLastCell).EntireRow.Delete
End If
Set myRange = Nothing
Set c = Nothing
Set myFirstCell = Nothing
Set myLastCell = Nothing
End Sub
'==============================================
Sub test2()
Dim c As Object
Dim myKey As String
Dim myRange As Range
Dim UnionRange As Range
Dim fAddress As String
Set myRange = Range("H10", Cells(Rows.Count, "H").End(xlUp))
myKey = "削除"
With myRange
Set c = .Find(What:=myKey, LookIn:=xlValues, lookat:=xlPart, _
SearchOrder:=xlByColumns, MatchByte:=False)
If Not c Is Nothing Then
fAddress = c.Address
Do
If UnionRange Is Nothing Then
Set UnionRange = c
Else
Set UnionRange = Union(c, UnionRange)
End If
Set c = .FindNext(c)
If c.Address = fAddress Then Exit Do
Loop
UnionRange.EntireRow.Delete
End If
End With
Set myRange = Nothing
Set UnionRange = Nothing
Set c = Nothing
End Sub
お礼
早々のご教示ありがとうございました。 バッチリできました。 またパターン２について併せて作成していただき感激です。 本当にありがとうございました。