Ich suche nach einer Möglichkeit per VBA Zeilen einer Tabelle zu unterlegen, wenn sie in mehrern Spalten mit einer anderen übereinstimmen, sprich, wenn sie doppelt sind.
Vielen Dank
Sub doppelte_markieren()
Dim i As Long, s As String
For i = 1 To 100 'Zeilen 1 bis 100
s = "sumproduct((A1:A100=" & Cells(i, "A").Address & ")*(C1:C100=" & Cells(i, "C").Address & ")*(D1:D100=" & Cells(i, "D").Address & "))"
Rows(i).Interior.ColorIndex = IIf(Evaluate(s) > 1, 6, xlNone)
Next i
End Sub
Sub Vergleich()
Dim iRowA As Integer, iRowB As Integer
Dim iCol As Integer, iColor As Integer
Dim iRowC As Integer
Dim bln As Boolean, blnColor As Boolean
iRowA = 2
iColor = 2
Do Until IsEmpty(Cells(iRowA, 1))
iRowB = iRowA + 1
Do Until IsEmpty(Cells(iRowB, 1))
For iCol = 1 To 3
If Cells(iRowA, iCol) <> Cells(iRowB, iCol) Then
bln = True
Exit For
End If
Next iCol
If bln = False Then
If blnColor = False Then
iColor = iColor + 1
End If
If Cells(iRowB, 1).Interior.ColorIndex = _
xlColorIndexNone Then
If Cells(iRowA, 1).Interior.ColorIndex = _
xlColorIndexNone Then
With Worksheets(3)
iRowC = .Cells(Rows.Count, 1).End(xlUp).Row + 1
.Range(.Cells(iRowC, 1), .Cells(iRowC, 3)).Value = _
Range(Cells(iRowB, 1), Cells(iRowB, 3)).Value
End With
End If
Range(Cells(iRowA, 1), Cells(iRowA, 3)). _
Interior.ColorIndex = iColor
Range(Cells(iRowB, 1), Cells(iRowB, 3)). _
Interior.ColorIndex = iColor
blnColor = True
End If
End If
iRowB = iRowB + 1
bln = False
Loop
blnColor = False
iRowA = iRowA + 1
Loop
End Sub