AW: Zeilen vergleichen wenn Wert in Spalte gleich
07.08.2024 14:49:55
Klaus
Hallo Gerd,
danke schon mal, aber funktioniert nicht ganz so.
in dieser Zeile "Set rngDel = Union(rngDel, C.Offset(1, 0).EntireRow)" bringt er "invalid procedure"
Außerdem markiert er die Zelle in Spalte A obwohl diese gleich mit der darunter ist.
Ich hab es mittlerweile auf umständliche Weise hinbekommen
Sub Compare()
Application.DisplayAlerts = False
Dim j As Long
Dim lastrow As Integer
lastrow = Cells(Rows.Count, 11).End(xlUp).Row
For j = lastrow To 2 Step -1
If Cells(j, 11).Value = Cells(j - 1, 11).Value Then
If Cells(j, 1).Value > Cells(j - 1, 1).Value Then
Cells(j - 1, 1).Interior.Color = 65280
End If
If Cells(j, 2).Value > Cells(j - 1, 2).Value Then
Cells(j - 1, 2).Interior.Color = 65280
End If
If Cells(j, 3).Value > Cells(j - 1, 3).Value Then
Cells(j - 1, 3).Interior.Color = 65280
End If
If Cells(j, 4).Value > Cells(j - 1, 4).Value Then
Cells(j - 1, 4).Interior.Color = 65280
End If
If Cells(j, 5).Value > Cells(j - 1, 5).Value Then
Cells(j - 1, 5).Interior.Color = 65280
End If
If Cells(j, 6).Value > Cells(j - 1, 6).Value Then
Cells(j - 1, 6).Interior.Color = 65280
End If
If Cells(j, 7).Value > Cells(j - 1, 7).Value Then
Cells(j - 1, 7).Interior.Color = 65280
End If
If Cells(j, 8).Value > Cells(j - 1, 8).Value Then
Cells(j - 1, 8).Interior.Color = 65280
End If
If Cells(j, 9).Value > Cells(j - 1, 9).Value Then
Cells(j - 1, 9).Interior.Color = 65280
End If
If Cells(j, 10).Value > Cells(j - 1, 10).Value Then
Cells(j - 1, 10).Interior.Color = 65280
End If
If Cells(j, 12).Value > Cells(j - 1, 12).Value Then
Cells(j - 1, 12).Interior.Color = 65280
End If
If Cells(j, 13).Value > Cells(j - 1, 13).Value Then
Cells(j - 1, 13).Interior.Color = 65280
End If
If Cells(j, 14).Value > Cells(j - 1, 14).Value Then
Cells(j - 1, 14).Interior.Color = 65280
End If
If Cells(j, 15).Value > Cells(j - 1, 15).Value Then
Cells(j - 1, 15).Interior.Color = 65280
End If
If Cells(j, 16).Value > Cells(j - 1, 16).Value Then
Cells(j - 1, 16).Interior.Color = 65280
End If
If Cells(j, 17).Value > Cells(j - 1, 17).Value Then
Cells(j - 1, 17).Interior.Color = 65280
End If
End If
Next j
Range("A1").Select
Application.DisplayAlerts = True
End Sub
Sub DeleteGrey()
Application.DisplayAlerts = False
Dim j As Long
Dim lastrow As Integer
lastrow = Cells(Rows.Count, 1).End(xlUp).Row
For j = lastrow To 2 Step -1
If Cells(j, 11).Interior.Color = 11382189 Then
Rows(j).Delete
End If
Next j
Range("A1").Select
Application.DisplayAlerts = True
End Sub
da gibt es bestimmt elegantere Lösungen, aber es funktioniert.
Für elegantere Lösungen bin ich jederzeit offen.
Gruß Klaus
