Sub EinfacheFinden()
Dim Zelle As Range
Static LastRow As Long
Dim letzteZeile As Long
Dim Bereich As Range
Dim SpalteA As Range
Dim letzteA As Long
Dim ZelleA As Range
If LastRow = 0 Then LastRow = 1
letzteZeile = ActiveSheet.Cells(Rows.Count, 13).End(xlUp).Row
letzteA = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
Set Bereich = ActiveSheet.Range("M2:M" & letzteZeile)
Set SpalteA = ActiveSheet.Range("A2:A" & letzteA)
For Each ZelleA In SpalteA
If ZelleA.Value <> "Nie gelaufen" Or ZelleA.Value <> "Verlust" _
Or ZelleA.Value <> "Außer Kontrolle" Or ZelleA.Value <> "AbhNr*" Or ZelleA.Value <> "" Then
For Each Zelle In Bereich
If WorksheetFunction.CountIf(Bereich, Zelle.Value) = 1 Then
With Range(Cells(Zelle.Row, 1), Cells(Zelle.Row, 16))
.Interior.Color = RGB(154, 205, 50)
LastRow = .Row
End With
With Range(Cells(Zelle.Row, 1), Cells(Zelle.Row, 1))
.Value = "Zugestellt"
LastRow = .Row
End With
With Range(Cells(Zelle.Row, 1), Cells(Zelle.Row, 1))
If .CommentThreaded Is Nothing Then
.AddCommentThreaded "Zugestellt lt. QSTATUS"
Else
.CommentThreaded.AddReply "Zugestellt lt. QSTATUS"
End If
End With
End If
Next Zelle
End If
Next ZelleA
End Sub