Thema Datum  Von Nutzer Rating
Antwort
Rot Range bei 2 Spalten
06.07.2019 19:27:01 Simsala
NotSolved
06.07.2019 20:56:04 Gast7777
NotSolved
06.07.2019 21:03:03 Gast78321
NotSolved
06.07.2019 21:04:57 Gast7777
NotSolved
06.07.2019 21:08:03 Gast72211
NotSolved
06.07.2019 21:09:42 Simsala
NotSolved
06.07.2019 21:13:02 Gast7777
NotSolved
06.07.2019 21:15:56 Gast94475
NotSolved
06.07.2019 21:17:54 Gast7777
NotSolved
06.07.2019 21:18:40 Gast34408
NotSolved
06.07.2019 21:21:45 Gast63353
NotSolved
06.07.2019 21:23:49 Gast7777
NotSolved
06.07.2019 21:26:01 Gast72662
NotSolved
06.07.2019 22:02:30 Gast7777
NotSolved
06.07.2019 22:14:15 Simsala
NotSolved
06.07.2019 22:28:31 Gast7777
NotSolved
06.07.2019 22:30:45 Simsala
Solved

Ansicht des Beitrags:
Von:
Simsala
Datum:
06.07.2019 19:27:01
Views:
913
Rating: Antwort:
  Ja
Thema:
Range bei 2 Spalten

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.

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 Sub



 mein bislang letzter Versuch ist

leider geht das nicht

Hier ein Link zu einem File - habe die Frage in einem anderen Forum auch schon gepostet

https://www.ms-office-forum.net/forum/attachment.php?attachmentid=118083&d=1562427427

Hat jemand eine Idee was und wie ich das ans laufen bringe?

Danke im Voraus

Simsala


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
Rot Range bei 2 Spalten
06.07.2019 19:27:01 Simsala
NotSolved
06.07.2019 20:56:04 Gast7777
NotSolved
06.07.2019 21:03:03 Gast78321
NotSolved
06.07.2019 21:04:57 Gast7777
NotSolved
06.07.2019 21:08:03 Gast72211
NotSolved
06.07.2019 21:09:42 Simsala
NotSolved
06.07.2019 21:13:02 Gast7777
NotSolved
06.07.2019 21:15:56 Gast94475
NotSolved
06.07.2019 21:17:54 Gast7777
NotSolved
06.07.2019 21:18:40 Gast34408
NotSolved
06.07.2019 21:21:45 Gast63353
NotSolved
06.07.2019 21:23:49 Gast7777
NotSolved
06.07.2019 21:26:01 Gast72662
NotSolved
06.07.2019 22:02:30 Gast7777
NotSolved
06.07.2019 22:14:15 Simsala
NotSolved
06.07.2019 22:28:31 Gast7777
NotSolved
06.07.2019 22:30:45 Simsala
Solved