Sub ChkDuplicates()
Dim arr(), z, dup(), flag
With Sheets("Testdaten")
z = .Cells.Find("*", .Cells(1), -4123, 2, 1, 2, False).Row
arr = Range(.Cells(1, 9), .Cells(z, 11)).Value
ReDim dup(LBound(arr, 1) To UBound(arr, 1))
For z = LBound(arr, 1) To UBound(arr, 1)
flag = True
If arr(z, 1) = arr(z, 3) Then
dup(z) = "Duplikat"
If arr(z, 1) = "" And arr(z, 3) = "" Then flag = False
Else
flag = False
End If
If flag Then
.Rows(z).Cells(9).Interior.Color = 65535
.Rows(z).Cells(11).Interior.Color = 65535
End If
Next z
.Cells(1, 21).Resize(UBound(dup, 1)).Value = Application.Transpose(dup)
End With
End Sub