Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Doppelte farblich in mehreren Spalten
01.03.2016 07:36:54
Erwin
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

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

Betreff
Datum
Anwender
Anzeige
AW: Doppelte farblich in mehreren Spalten
01.03.2016 10:45:30
Steve
Hallo Erwin,
in folgender Mappe habe ich dir meinen Lösungsvorschlag verpackt. Dabei kannst du bis zu drei Spalten auswählen und prüfen lassen.
https://www.herber.de/bbs/user/103997.xlsm
Eine Anmerkung dazu noch: Es sortiert dir nicht die ganze Zeile sondern nur von erster bis letzter Spalte der Eingabe. Wenn das nicht gewünscht ist, tausche bitte den Sortier-Abschnitt aus:
' 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
lg Steve

Anzeige
AW: Doppelte farblich in mehreren Spalten
01.03.2016 10:51:40
Steve
Ich sehe grad, beim BeforeClose-Event der Userform ist mir ein Fehler unterlaufen, das muss natürlich "True" lauten:
Private Sub UserForm_BeforeClose()
Application.ScreenUpdating = True
End Sub
lg Steve

AW: Doppelte farblich in mehreren Spalten
01.03.2016 13:06:02
Erwin
Hallo Steve,
erstmal vielen herzlichen Dank für die umfangreiche Lösung, die auch gut funktioniert.
Beim testen ist mir aufgefallen, dass, sollten die ersten beiden Zeilen identisch (Name, Vorname, Geb.dat.) sein, dein tool das nicht erkennt und überspringt.
Außerdem wollte ich fragen, ob das tool die letzte Zeile nicht selbständig erkennen kann, weil ich immer unterschiedlich lange Listen habe (oft mehrere tausend Zeilen)?
Grüße - Erwin

Anzeige
AW: Doppelte farblich in mehreren Spalten
01.03.2016 13:34:08
Steve
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

Anzeige
AW: Doppelte farblich in mehreren Spalten
01.03.2016 13:55:33
Erwin
Hi Steve,
super für die beiden Ergänzungen, die passen jetzt.
Leider habe ich festgestellt, wenn ich nur die Spalte mit dem Geburtsdatum als einziges Kriterium zum sortieren benutze, dass hier der Laufzeitfehler 13 - Typen unverträglich kommt:
' Sortieren
If TextBox2 = "" Then
wks.Range(wks.Cells(TextBox4, TextBox1), wks.Cells(TextBox5, TextBox1)).Sort _
Key1:=wks.Cells(TextBox4, TextBox1), Order1:=xlAscending, Header:=xlNo
Wenn ich das Geburtsdatum mit anderen Kriterien prüfe, passt es.
Gibt es da noch eine Möglichkeit das abzuändern?
Grüße - Erwin

Anzeige
AW: Doppelte farblich in mehreren Spalten
01.03.2016 14:06:00
Steve
Hallo Erwin,
danke für die Info, das war ein Fehler meinerseits. Wenn man sich die Zeilen darunter anschaut, fällt auf dass ich alle drei Vorkommnisse von "TextBox1" in die Funktion CStr() hätte packen müssen, was nichts anderes bedeutet als "konvertiere zum Datentyp 'String'".
If TextBox2 = "" Then
wks.Range(wks.Cells(TextBox4, CStr(TextBox1)), wks.Cells(TextBox5, CStr(TextBox1))).Sort _
Key1:=wks.Cells(TextBox4, CStr(TextBox1)), Order1:=xlAscending, Header:=xlNo
Entschuldige, das ist mir einfach durch die Lappen gerutscht da ich mich mehr auf die Funktion mit zwei bzw. drei Spalten konzentriert habe.
lg Steve

Anzeige
tool - TOLLLL
01.03.2016 14:20:10
Erwin
Hi Steve,
einfach genial, wie schnell du das gelöst hast.
Vielen herzlichen Dank für dieses kleine tool, das - und das ist das Beste - sehr flexibel eingesetzt werden kann.
Grüße - Erwin

Na, dann doch alles OK! Gruß owT
01.03.2016 16:13:53
Luc:-?
:-?

315 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige