06.07.2019, 20:02
Hallo zusammen
ich hoffe und bin mir sicher, dass ihr mir weiterhelfen könnt.
ich habe ein Makro das mir eine Reihe nach doppelten Einträgen durchsucht und diese dann farblich hervor hebt - soweit klappt das prima.
Jetzt habe ich aber 2 Reihen - mit Vorname und Nachname - ich möchte gerne das die beiden zusammengenommen werden und dann auf Duplikate überprüft werden.
mein bislang letzter Versuch leider geht das nicht
Im Anhang ist ein Beispielfile - Vorname und Zuname sollten zusammengenommen werden und dann, falls es andere Einträge mit demselben Vornamen+Zunamen gibt, farbig gekennzeichnet werden
Hat jemand eine Idee was und wie ich das ans laufen bringe?
Danke im Voraus
Simsala[attachment=31]
ich hoffe und bin mir sicher, dass ihr mir weiterhelfen könnt.
ich habe ein Makro das mir eine Reihe nach doppelten Einträgen durchsucht und diese dann farblich hervor hebt - soweit klappt das prima.
Jetzt habe ich aber 2 Reihen - mit Vorname und Nachname - ich möchte gerne das die beiden zusammengenommen werden und dann auf Duplikate überprüft werden.
Code:
Sub CheckDoppelte()
'Doppelte Einträge von Reihe F+G unterschiedlich farbig markieren
Dim xRg As Range
Dim xTxt As String
Dim xCell As Range
Dim xChar As String
Dim xCellPre As Range
Dim xCIndex As Long
Dim xCol As Collection
Dim I As Long
On Error Resume Next
If ActiveWindow.RangeSelection.Count > 1 Then
xTxt = ActiveWindow.RangeSelection.AddressLocal
Else
xTxt = ActiveSheet.UsedRange.AddressLocal
End If
Set xRg = Range("F10:G100")
If xRg Is Nothing Then Exit Sub
xCIndex = 2
Set xCol = New Collection
For Each xCell In xRg
On Error Resume Next
If xCell.Value <> "" Then
xCol.Add xCell, xCell.Text
If Err.Number = 457 Then
xCIndex = xCIndex + 1
Set xCellPre = xCol(xCell.Text)
If xCellPre.Interior.ColorIndex = xlNone Then xCellPre.Interior.Color = RGB(xRed, xGreen, xBlue)
xCell.Interior.Color = xCellPre.Interior.Color
ElseIf Err.Number = 9 Then
MsgBox "Zu viele Duplikate - Frabe ist ausgegangen!", vbCritical, "Dupplikate markieren"
Exit Sub
End If
xRed = Application.WorksheetFunction.RandBetween(0, 255)
xGreen = Application.WorksheetFunction.RandBetween(0, 255)
xBlue = Application.WorksheetFunction.RandBetween(0, 255)
On Error GoTo 0
End If
Next
End Submein bislang letzter Versuch leider geht das nicht
Im Anhang ist ein Beispielfile - Vorname und Zuname sollten zusammengenommen werden und dann, falls es andere Einträge mit demselben Vornamen+Zunamen gibt, farbig gekennzeichnet werden
Hat jemand eine Idee was und wie ich das ans laufen bringe?
Danke im Voraus
Simsala[attachment=31]