Guten Morgen zusammen,
ich habe in einer Spalte, in verschiedenen Zellen ein Haufen von Postleitzahlen für verschiedene Bundesländer, Städte und Landkreise mit Komma eingegeben.
Jetzt ist mit aufgefallen, dass in verschiedenen Landkreisen Deutschlands die Postleitzahlen sich wiederholen.
Ich suche jetzt nach einer Möglichkeit, dass mir die PLZ farbig angezeigt werden, die doppelt sind . Gibt es dafür was?!
Bislang kannte ich nur die Funktion, dass mir Excel komplett identische Zellen anzeigt.
Jedoch habe ich in einer Zelle bis zu 25 verschiedene Postleitzahlen. Diese müssten mit den anderen Zellen, die ebenfalls eine hohe Anzahl an PLZ besitzen verglichen werden und die doppelten sollen farbig gekennzeichnet werden.
Vielen Dank schon einmal für eure Hilfe und viele Grüße aus Mönchengladbach
Karin :s
Hallo Karin,
rein technisch gesprochen, kann man die Liste mit "Dictionary" zuerst zählen und dann in einem zweiten Schritt die PLZ farblich markieren. Ob das dann noch einigermaßen übersichtlich ist, wäre die Frage.
Ohne ein (kleine) Bsp-Datei wird es nicht gehen, aber wichtiger ist es, den Sinn des Ansatzes zu begründen.
mfg
Hi Karin,
mal ein Vorschlag ins Blaue (da ich deine Datei nicht kenne):
Bearbeite die Spalte mit "Text in Spalten". Als Trenner nimmst du das Komma. Danach kannst du ganz einfach mit der bedingten Formatierung deine Duplikate färben.
Moin!
Ergänzend:
Zitat: in verschiedenen Zellen ein Haufen von Postleitzahlen für verschiedene Bundesländer, Städte und Landkreise mit Komma eingegeben.
Eine Zelle sollte, so sie zu einer auswertbaren Kalkulation/Datenbank gehört, nicht als Container von Texten missbraucht werden.
Gruß Ralf
Ich habe euch einfach mal einen Auszug meiner Tabelle angehangen.
Zwei PLZ sind bereits farbig markiert, dies ist von mir manuell gemacht worden.
Jedoch ist es bei einer Anzahl von mehreren Hundert PLZ nicht mögich, jede PLZ manuell nach Dopplungen nachzuschauen.
(08.02.2017, 09:59)RPP63 schrieb: [ -> ]Moin!
Ergänzend:
Eine Zelle sollte, so sie zu einer auswertbaren Kalkulation/Datenbank gehört, nicht als Container von Texten missbraucht werden.
Gruß Ralf
Ich bin da ganz bei dir, aber wenn der Chef es anders will... :20:
Hi Karin,
Zitat:Ich bin da ganz bei dir, aber wenn der Chef es anders will... [img]
Dateiupload bitte im Forum! So geht es: Klick mich!
]
dann frage doch mal deinen Chef, ob er sich das denn selber antun würde? Meistens haben doch die Herrschaften absolut keine Ahnung - und davon sehr viel.
Aber um auf deine Anfrage zurückzukommen:
Kopiere die Spalte A und füge sie als Spalte C wieder ein. Dann, wie ich dir bereits geraten hatte, Text in Spalten und mit bedingter Formatierung fäarben.
Über wie viele Dubletten reden wir eigentlich?
Hier wäre es sinnvoll, dass Du zunächst mal eine Aufstellung dieser machst.
Dazu könnte dies hilfreich sein:
http://fa-technik.adfc.de/code/opengeodb/
Dann könnte man ein Makro schreiben, dass Dir einmalig die Arbeit des Suchens und Färbens abnimmt.
(Ändert aber nichts an meiner Einschätzung, dass man so etwas anders lösen sollte)
[nicht ganz ernst gemeint]
An Deinen Chef:
Dies ist eigentlich eine Aufgabe für einen Dienstleister oder etlicher zu bezahlender Mitarbeiterstunden.
Hab aber gehört, dass es sich bei diesem Forum um einen gemeinnützigen Verein handelt, dem Spenden immer willkommen sind …
Gruß Ralf
Hallo Karin,
teste mal diesen Code:
Code:
Sub Fen()
Dim rng As Range
Sheets(1).Activate
Sheets(2).Cells.Clear
With CreateObject("scripting.dictionary")
For i = 1 To 8
F0 = Split(Cells(i, "A"), ",")
For Each F In F0
If Not .exists(F) Then
.Add (F), 1
Else
.Item(F) = .Item(F) + 1
End If
Next F
Next i
i = 0
'Sheets(2).Cells(1, 1).Resize(.Count, 2) = Application.Transpose(Array(.keys, .Items))
For Each k In .keys
If .Item(k) > 1 Then
i = i + 1
Sheets(2).Cells(i, "A").Resize(, 2) = Array(k, .Item(k))
End If
Next k
End With
Sheets(2).Activate
lr = Cells(Rows.Count, "A").End(xlUp).Row
For i = 1 To lr
Set rng = Sheets(1).Columns(1).Find(Sheets(2).Cells(i, "A"), lookat:=xlPart)
If Not rng Is Nothing Then
Anf = rng.Address
Do
P = InStr(rng.Value, Sheets(2).Cells(i, "A"))
rng.Characters(Start:=P, Length:=5).Font.Color = vbRed
Set rng = Sheets(1).Columns(1).FindNext(rng)
Loop Until Anf = rng.Address
End If
Next i
End Sub
Es muss ein Sheets(2) existieren.
mfg
Vielen lieben Dank für die zahlreichen Tipps.
Ich werde gleich noch einmal die Tabelle mit meinem Chef besprechen :s .