【VBA】特定の文字を含む行の処理：検索・削除・別シートにコピー

Sub FindRowWithSpecificText()

Dim ws As Worksheet
Dim cell As Range

Set ws = ThisWorkbook.Sheets("Sheet1")

' シート内で "Apple" を検索
Set cell = ws.Cells.Find(What:="Apple", LookIn:=xlValues, LookAt:=xlPart)

If Not cell Is Nothing Then

MsgBox "文字列 'Apple' を含むのは行 " & cell.Row & " です。"

Else

MsgBox "文字列 'Apple' は見つかりませんでした。"

End If

End Sub

Sub HighlightRowsWithSpecificText()

Dim ws As Worksheet
Dim cell As Range
Dim searchText As String

Set ws = ThisWorkbook.Sheets("Sheet1")
searchText = "Apple" ' 検索文字列

' データ範囲をループ
For Each cell In ws.UsedRange

If InStr(cell.Value, searchText) > 0 Then

ws.Rows(cell.Row).Interior.Color = RGB(255, 255, 0) ' 行の背景色を黄色に

End If

Next cell

MsgBox "特定の文字を含む行を強調表示しました。"

End Sub

Sub DeleteRowsWithSpecificText()

Dim ws As Worksheet
Dim cell As Range
Dim searchText As String
Dim i As Long

Set ws = ThisWorkbook.Sheets("Sheet1")
searchText = "Apple" ' 検索文字列

' データ範囲を逆順にループ
For i = ws.UsedRange.Rows.Count To 1 Step -1

If InStr(ws.Cells(i, 1).Value, searchText) > 0 Then

ws.Rows(i).Delete

End If

Next i

MsgBox "特定の文字を含む行を削除しました。"

End Sub

Sub CopyRowsWithSpecificText()

Dim sourceWs As Worksheet
Dim targetWs As Worksheet
Dim cell As Range
Dim searchText As String
Dim targetRow As Long

Set sourceWs = ThisWorkbook.Sheets("Sheet1")
Set targetWs = ThisWorkbook.Sheets("Sheet2")
searchText = "Apple" ' 検索文字列
targetRow = 1 ' コピー先の開始行

' データ範囲をループ
For Each cell In sourceWs.UsedRange

If InStr(cell.Value, searchText) > 0 Then

sourceWs.Rows(cell.Row).Copy Destination:=targetWs.Rows(targetRow)
targetRow = targetRow + 1 ' 次の行にコピー

End If

Next cell

MsgBox "特定の文字を含む行をコピーしました。"

End Sub