Doppelte farblich in mehreren Spalten

Guten Morgen,
ich habe mir mit der Zeit ein funktionstüchtiges Makro zusammengebastelt, welches die doppelten Werte einer einzigen sortierten Spalte markiert (weiß = Wert nur einmal vorhanden, grün = 1. Wert eines mehrfach vorkommenden Wertes und rot = zweiter ff. Wert eines mehrfach vorkommenden Wertes).
Ich weis, dass das Makro aus Sicht von euch Spezialisten nicht schön ist, aber es läuft...
Es kommt jetzt immer öfter vor, dass ich nicht nur einspaltig sondern zwei- oder mehrspaltig prüfen muss, ob die Werte doppelt / mehrfach vorkommen.
Kann man das Makro so erweitern, dass man damit auch zwei oder mehr Spalten prüfen kann und dann nur die Doppelten markiert, die in den angegebenen Spalten den Kriterien entsprechen?
Ein Beispiel https://www.herber.de/bbs/user/103981.xlsm, wie es heute läuft und wie es sein soll, habe ich angehängt.
Zur Info; in einem späteren Schritt werden die roten Zeilen durch ein weiteres Makro gelöscht.
Grüße - Erwin

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

' Sortieren - ganze Zeile If TextBox2 = "" Then wks.Rows(TextBox4 & ":" & TextBox5).Sort _ Key1:=wks.Cells(TextBox4, TextBox1), Order1:=xlAscending, Header:=xlNo ElseIf TextBox2 "" And TextBox3 = "" Then wks.Rows(TextBox4 & ":" & TextBox5).Sort _ Key1:=wks.Cells(TextBox4, CStr(TextBox1)), Order1:=xlAscending, _ Key2:=wks.Cells(TextBox4, CStr(TextBox2)), Order2:=xlAscending, Header:=xlNo ElseIf TextBox2 "" And TextBox3 "" Then wks.Rows(TextBox4 & ":" & TextBox5).Sort _ Key1:=wks.Cells(TextBox4, CStr(TextBox1)), Order1:=xlAscending, _ Key2:=wks.Cells(TextBox4, CStr(TextBox2)), Order2:=xlAscending, _ Key3:=wks.Cells(TextBox4, CStr(TextBox3)), Order3:=xlAscending, Header:=xlNo End If

Hallo Erwin,
#1: Du hast mir aber einen riesen Schrecken eingejagt. Natürlich erkennt das er die ersten beiden Zeilen, jedoch hat einer deiner Namen ein Leerzeichen hinten drann und einer nicht. Ersetze den Abschnitt "Verketten":

' Spalte A: Verketten
wks.Cells(TextBox4, "A").FormulaR1C1 = "=Trim(RC[" & Columns(CStr(TextBox1)).Column + 1 & "])"
If TextBox2  "" Then wks.Cells(TextBox4, "A").FormulaR1C1 = wks.Cells(TextBox4, "A"). _
FormulaR1C1 & "&"" ""&" & "Trim(RC[" & Columns(CStr(TextBox2)).Column + 1 & "])"
If TextBox3  "" Then wks.Cells(TextBox4, "A").FormulaR1C1 = wks.Cells(TextBox4, "A").FormulaR1C1 & "&"" ""&" & "Trim(RC[" & Columns(CStr(TextBox3)).Column + 1 & "])"

Dadurch arbeitet das Makro zwar jetzt richtig, deine Daten sind aber immer noch nicht bereinigt. Google hat bestimmt hunderte Beiträge zum Thema "Trim" bzw. "Glätten" von Datenmengen.
#2: Ja klar kann man die letzte Zeile automatisch erkennen lassen. Da ich jetzt nicht allzuviel _ am Code ändern möchte, habe ich das jetzt in das AfterUpdate-Event der TextBox1 mit reingepackt. Ist zwar nicht die eleganteste Art, aber funktioniert. Zudem kannst du auch willkürlich die Endzeile noch ändern:


Private Sub TextBox1_AfterUpdate()
If IsNumeric(TextBox1) Then
MsgBox "Bitte nur Buchstaben eingeben!"
Else
TextBox1 = UCase(TextBox1)
'on error resume next
With Sheets(CStr(ComboBox1))
TextBox5 = .Cells(.Rows.Count, Columns(CStr(TextBox1)).Column).End(xlUp).Row
End With
End If
End Sub

lg Steve

Beliebteste Forumthreads (12 Monate)

Doppelte farblich in mehreren Spalten

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

313 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Doppelte farblich in mehreren Spalten

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

313 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread