Sub BegriffSuchenZeilenLoeschen()
Dim wks As Worksheet, lngZeile As Long, lngZeile1 As Long, lngZeile2 As Long
Dim varSuchen
Set wks = ActiveSheet
With wks
'Suchbegriff eingeben
varSuchen = InputBox("Suchwort?", "Wort suchen und Blöck löschen")
If varSuchen = False Or varSuchen = "" Or varSuchen = " " Then Exit Sub
'Inhalte aus Zellen mit nur Leerzeichen entfernen
For lngZeile = 1 To .Cells(.Rows.Count, 1).End(xlUp).Row
If Trim(.Cells(lngZeile, 1)) = "" Then
.Cells(lngZeile, 1).ClearContents
End If
Next
'Von unten aufwärts die letzte und 1. Zeile der Textblocke ermitteln _
und prüfen, ob Suchtext im Block enthalten
lngZeile = .Cells(.Rows.Count, 1).End(xlUp).Row
lngZeile2 = lngZeile 'letzte Textzeile
Do Until lngZeile = 1
'1. Zeile des Blocks ermitteln
Do Until .Cells(lngZeile, 1) = ""
If lngZeile = 1 Then
lngZeile1 = lngZeile
Exit Do
End If
lngZeile = lngZeile - 1
Loop
If lngZeile1 1 Then
lngZeile1 = lngZeile + 1
End If
'Block prüfen
If Not .Range(.Cells(lngZeile1, 1), .Cells(lngZeile2, 1)).Find(what:=varSuchen, _
LookIn:=xlValues, lookat:=xlPart) Is Nothing Then
.Range(.Rows(lngZeile1), .Rows(lngZeile2)).Delete shift:=xlShiftUp
End If
'letzte Zeile des vorherigen Blocks ermitteln
Do Until .Cells(lngZeile, 1) ""
If lngZeile = 1 Then Exit Do
lngZeile = lngZeile - 1
Loop
lngZeile2 = lngZeile
Loop
End With
End Sub
Sub BegriffSuchenZeilenLoeschen()
Dim wks As Worksheet, lngZeile As Long, lngZeile1 As Long, lngZeile2 As Long
Dim varSuchen
Set wks = ActiveSheet
With wks
'Suchbegriff eingeben
varSuchen = InputBox("Suchwort?", "Wort suchen und Blöck löschen")
If varSuchen = False Or varSuchen = "" Or varSuchen = " " Then Exit Sub
'Inhalte aus Zellen mit nur Leerzeichen entfernen
For lngZeile = 1 To .Cells(.Rows.Count, 1).End(xlUp).Row
If Trim(.Cells(lngZeile, 1)) = "" Then
.Cells(lngZeile, 1).ClearContents
End If
Next
'Von unten aufwärts die letzte und 1. Zeile der Textblocke ermitteln _
und prüfen, ob Suchtext im Block enthalten
lngZeile = .Cells(.Rows.Count, 1).End(xlUp).Row
lngZeile2 = lngZeile 'letzte Textzeile
Do Until lngZeile = 1
'1. Zeile des Blocks ermitteln
Do Until .Cells(lngZeile, 1) = ""
If lngZeile = 1 Then
lngZeile1 = lngZeile
Exit Do
End If
lngZeile = lngZeile - 1
Loop
If lngZeile1 1 Then
lngZeile1 = lngZeile + 1
End If
'Block prüfen
If Not .Range(.Cells(lngZeile1, 1), .Cells(lngZeile2, 1)).Find(what:=varSuchen, _
LookIn:=xlValues, lookat:=xlPart) Is Nothing Then
.Range(.Rows(lngZeile1), .Rows(lngZeile2)).Delete shift:=xlShiftUp
End If
'letzte Zeile des vorherigen Blocks ermitteln
Do Until .Cells(lngZeile, 1) ""
If lngZeile = 1 Then Exit Do
lngZeile = lngZeile - 1
Loop
lngZeile2 = lngZeile
Loop
End With
End Sub