VBA | Zelleninhalt mit Liste vergleichen

Sub textsuche2()
'nList = Falschparker
'xList = Richtigparker
Dim doppelZeile As Boolean, ausgabeKeineTreffer As Boolean
Dim zeile As Long, treffer As Long, t As Long, nTreffer As Long, trefferzeile As Long
Dim bereich As Range, zelle As Range, ausgabeStart As Range
Dim sText As String, xList As String, eintrag As String, ausBlatt As String, ausBereich As  _
String, nList As String
ausBlatt = ActiveSheet.Name
ausBereich = "B6:D14, B18:D22"          'welchen bereich untersuchen ob "RD/P"
sText = "RD/P"
doppelZeile = False
'Range("B25:B35").Value = ""   'Wo Ergebnisse reingeschreiben werden: Value löschen
Set ausgabeStart = ActiveWorkbook.Sheets(ausBlatt).Range("B25")      ' Wo Ergebnisse  _
reinschreiben
ausgabeKeineTreffer = True
Set bereich = ActiveWorkbook.Sheets(ausBlatt).Range(ausBereich)
treffer = 0
For Each zelle In bereich
zeile = zelle.Row
'neuer Eintrag beim Beginn einer neuen Zeile im Schleifendurchlauf hinzufügen
If zelle.Column - bereich.Column = 0 Then
If nList  "" Then
nList = nList & ", "
End If
nList = nList & ActiveWorkbook.Sheets(ausBlatt).Range("E" & zelle.Row)        'welche    _
_
_
spalte übergeben
nTreffer = nTreffer + 1
End If
'bisheriger
If InStr(1, zelle.Value, sText) > 0 And (trefferzeile  zeile Or doppelZeile) Then
If xList  "" Then
xList = xList & ", "
End If
xList = xList & ActiveWorkbook.Sheets(ausBlatt).Range("E" & zelle.Row)
trefferzeile = zelle.Row
treffer = treffer + 1
'eintrag aus Liste leerer Zellen entfernen
If InStr(1, nList, ",") = 0 Then
nList = ""
Else
nList = Left(nList, InStr(1, Application.WorksheetFunction.Substitute(nList, ",", "@ _
_
_
@@", Len(nList) - Len(Application.WorksheetFunction.Substitute(nList, ",", ""))), "@@@") - 1)
End If
nTreffer = nTreffer - 1
End If
Next zelle
'Ausgabe der Liste(n)
If treffer = 0 Then
MsgBox "keine Treffer."
Else
'MsgBox "xList: " & xList & Chr(10) & "nList: " & nList    'Ausgabefenster anzeigen
If ausgabeKeineTreffer Then
xList = nList
treffer = nTreffer
End If
For t = 1 To nTreffer
If t      If Range("B25").Value  eintrag And Range("B26").Value  eintrag And Range("B27") _
_
_
.Value  eintrag ...... Then
ausgabeStart.Offset(t - 1, 0) = eintrag
End If
Next t
End If
End Sub