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
Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden
Suche nach den besten AntwortenEntdecke unsere meistgeklickten Beiträge in der Google Suche
Top 100 Threads jetzt ansehen