Sub xlph_Doppelte_Markieren(rng As Range, arCols() As Variant)
Dim ar As Variant
Dim i As Long, Z_Offset As Long
Dim k As Integer
Dim D As Object
Dim sAdr As String, sVgl As String
On Error GoTo ENDE
Application.ScreenUpdating = False
Set D = CreateObject("Scripting.Dictionary")
rng.Parent.Cells.Interior.ColorIndex = xlColorIndexNone
Z_Offset = rng.Row - 1
ar = rng.Value
For i = 1 To UBound(ar)
sVgl = ""
For k = 0 To UBound(arCols)
sVgl = sVgl & "~" & ar(i, arCols(k))
Next
D(sVgl) = D(sVgl) + 1
If D(sVgl) > 1 Then
If Len(sAdr & ",A" & i + Z_Offset) > 256 Then
Intersect(rng, Range(Mid(sAdr, 2)).EntireRow).Interior.ColorIndex = 4
sAdr = ""
End If
sAdr = sAdr & ",A" & i + Z_Offset
End If
Next
If Len(sAdr) Then Intersect(rng, Range(Mid(sAdr, 2)).EntireRow).Interior.ColorIndex = 4
ENDE:
If Err Then MsgBox Err.Description, , "Fehler: " & Err
Application.ScreenUpdating = True
End Sub