Sub ChkDuplicates()
Dim arr(), z, dup(), flag
With Sheets("Testdaten")
'Bereich
'letzte Zeile
z = .Cells.Find("*", .Cells(1), -4123, 2, 1, 2, False).Row
'Daten Spalte I - K
'beginne mit Zeile 1
arr = Range(.Cells(1, 9), .Cells(z, 11)).Value
'Hilfsspalte U
ReDim dup(LBound(arr, 1) To UBound(arr, 1))
'Daten im Array vergleichen
For z = LBound(arr, 1) To UBound(arr, 1)
'Zeiger
flag = True
If arr(z, 1) = arr(z, 3) Then
'ist Duplikat
dup(z) = "Duplikat"
'beide leer
If arr(z, 1) = "" And arr(z, 3) = "" Then flag = False
Else
flag = False
End If
'färben wenn Zeiger
If flag Then
.Rows(z).Cells(9).Interior.Color = 65535
.Rows(z).Cells(11).Interior.Color = 65535
End If
Next z
'Spalte U
.Cells(1, 21).Resize(UBound(dup, 1)).Value = Application.Transpose(dup)
End With
End Sub
|