anstatt löschen, rot markieren
08.04.2009 07:47:29
Reinhard
der untenstehende Code sucht die Spalten A und B nach doppelten Datensätzen ab und löscht wohl die doppelten Daten. Wie kann ich den Code umstellen, damit die Daten nicht gelöscht werden, sondern rot und mit Fettdruck markiert werden. Ich freue mich über jede Hilfestellung und Rückmeldung.
Freundliche Grüße
Reinhard
Public Sub DoppelteRaus()
Dim lLetzte As Long
Dim lZeile_1 As Long
Dim lZeile_2 As Long
Dim rBereich As Range
Application.ScreenUpdating = False
With Worksheets("Tabelle1")
lLetzte = .Range("A65536").End(xlUp).Row
For lZeile_1 = 2 To lLetzte
For lZeile_2 = (lZeile_1 + 1) To lLetzte
If .Range("A" & lZeile_1).Value = .Range("A" & lZeile_2).Value And _
.Range("B" & lZeile_1).Value = .Range("B" & lZeile_2).Value Then
If rBereich Is Nothing Then
Set rBereich = Cells(lZeile_1, 1)
Else
Set rBereich = Union(rBereich, Cells(lZeile_1, 1))
End If
Exit For
End If
Next lZeile_2
Next lZeile_1
End With
If Not rBereich Is Nothing Then
rBereich.EntireRow.Delete
Else
MsgBox "Es gibt keine doppelten Einträge, die gelöscht werden könnten.", _
64, " Hinweis für " & Application.UserName
End If
Application.ScreenUpdating = True
End Sub