Sub Loeschen()
Dim lngZeile As Long
Dim lngZaehler As Long
Dim arrWerte()
Dim bytWerte As Byte
arrWerte = Array("Suchbegriff", "Suchbegriff2", "Suchbegriff3 usw")
Application.ScreenUpdating = False
For lngZeile = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row To 1 Step -1
For bytWerte = 0 To UBound(arrWerte())
If InStr(Cells(lngZeile, 2), arrWerte(bytWerte)) > 0 Or _
InStr(Cells(lngZeile, 5), arrWerte(bytWerte)) > 0 Then
Rows(lngZeile).Delete shift:=xlUp
lngZaehler = lngZaehler + 1
End If
Next bytWerte
Next lngZeile
Application.ScreenUpdating = True
MsgBox "Es wurden " & lngZaehler & " Zeilen gelöscht"
End Sub