特定のテキストを見つけてそれより上の3行を削除する

Question

マクロに問題があります。

特定のテキストを1行に配置し、その上に3行を削除する手助けが必要です。 これは私が使用してきたもので、動作しません。 Image of: What I need deleted and the required end result. Also the Macros that I'm using

Sub Delete_Rows() 

Dim x 
For x = Cells(Rows.Count, ActiveCell.Column).End(xlUp).Row To ActiveCell.Row Step -1 
    If Cells(x, 1) = "TOT" Then 
     Cells(x, 1).EntireRow.Delete  
     Cells(x - 1, 1).EntireRow.Delete 
     Cells(x - 2, 1).EntireRow.Delete 
     Cells(x - 3, 1).EntireRow.Delete 
End If 

End Sub 

私も、この共通の問題に対する他の解決策をオンラインで周りを見回してきましたが、何も私のために働いていません。このマクロをExcelワークブックのどのページでも使用できるようにする必要があります。

ありがとうございました！

Answer 1

私が正しく理解していれば、下の編集は

Sub Delete_Rows() 

Dim xRow As Integer 
Dim strSearch As String 

strSearch = "TOT" 
' Assuming Total is in column C as your picture shows, but you can configure to search anywhere 

xRow = Range("C" & Rows.Count).End(xlUp).Row 
Range("$C1:C" & xRow).Select 

Selection.Find(What:=strSearch, After:=ActiveCell, LookIn:=xlFormulas, _ 
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ 
MatchCase:=False, SearchFormat:=False).Select 

Range(ActiveCell.Row & ":" & ActiveCell.Offset(-3, 0).Row).Select 
Selection.Delete Shift:=xlUp 

End Sub 

Answer 2

なぜループを作るのですか？なぜ物事を自動で選ぶだけではないのですか？

Sub Delete_Rows() 
    Const WordToLook = "TOT" 
    Dim RowWord As Long 
    RowWord = Columns(3).Find(WordToLook, LookAt:=xlWhole).Row 
    Rows(RowWord - 3 & ":" & RowWord - 1).Delete 
End Sub 

Answer 3

これはどこでもシート内の "TOT" を見つけて、その上に3行を削除します。

Sub Delete() 
Dim find As String: find = "TOT" 
Dim rng As Range 

Set rng = Sheets("Sheet1").Cells.find(What:=find, After:=Sheets("Sheet1").Cells(1, 1), LookIn:=xlValues, Lookat:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True) 

If Not rng Is Nothing Then 
    rng.EntireRow.Delete 
    rng.Offset(-1).EntireRow.Delete 
    rng.Offset(-2).EntireRow.Delete 
    rng.Offset(-3).EntireRow.Delete 
End If 

End Sub