Kombobox füllen ohne doppelte Werte

Hallo Forum,

ich habe zwei Spalten nebeneinander : "PLZ" - "Ort".

Alle gefüllten Spalten sind zu einem Bereich zusammengefasst mit dem Namen "PlzOrt".

Diesen Bereich lese ich zweispaltig in einer UF in eine Kombobox ein mit folgendem Code:


Private Sub UserForm_Activate()
Dim varArrayNeu As Variant
varArrayNeu = Range("PlzOrt")
cmbNeuPLZ.List = varArrayNeu
End Sub

Es gibt aber zwei Schönheitsfehler:

1. Es kommen die gleichen Postleitzahlen öfters vor. Also ist Liste ellenlang mit sich immer wiederholenden Einträgen!

2. Sie sind nicht sortiert (die gesamte Tabelle ist nach anderen Kriterien sortiert und kann deshalb nicht umsortiert werden.)

Wie kann ich nun die Postleitzahlen und die dazugehörigen Orte so einlesen, dass jede PLZ nur 1 Mal in der Kombo steht? Und das, wenn irgend wie möglich auch noch nach PLZ aufsteigend sortiert? Und nach wie vor zweispaltig? Ist das machbar?

Vielen Dank schon mal für Eure Unterstützung!

Grüße
Franz

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Franz,
je weiter du kommst, desto haarigre wird die Sachen. Außerdem entwickelst du dich zum Dauerbrenner in diesem Forum. Hier mein Lösungsvorschlag:


Option Explicit
Private Sub UserForm_Activate()
Dim varArrayNeu As Variant, strArray() As String, lngIndex As Long
Dim lngZaehler As Long, strMerker As String
varArrayNeu = Range("PlzOrt")
Call sortieren(LBound(varArrayNeu), UBound(varArrayNeu), varArrayNeu)
For lngIndex = LBound(varArrayNeu) To UBound(varArrayNeu)
If strMerker <> varArrayNeu(lngIndex, 1) Then
lngZaehler = lngZaehler + 1
strMerker = varArrayNeu(lngIndex, 1)
End If
Next
ReDim strArray(1 To lngZaehler, 1 To 2)
lngZaehler = 0
For lngIndex = LBound(varArrayNeu) To UBound(varArrayNeu)
If strMerker <> varArrayNeu(lngIndex, 1) Then
lngZaehler = lngZaehler + 1
strArray(lngZaehler, 1) = varArrayNeu(lngIndex, 1)
strArray(lngZaehler, 2) = varArrayNeu(lngIndex, 2)
strMerker = varArrayNeu(lngIndex, 1)
End If
Next
cmbNeuPLZ.List = CVar(strArray)
End Sub
Private Sub sortieren(Untergrenze As Long, Obergrenze As Long, varArray As Variant)
Dim intIndex1 As Long, intIndex2 As Long, Element1 As Variant, Element2 As Variant, Zwischenspeicher As Variant
intIndex1 = Untergrenze
intIndex2 = Obergrenze
Zwischenspeicher = varArray(((Untergrenze + Obergrenze) / 2) \ 1, 1)
Do
Do While varArray(intIndex1, 1) < Zwischenspeicher
intIndex1 = intIndex1 + 1
Loop
Do While Zwischenspeicher < varArray(intIndex2, 1)
intIndex2 = intIndex2 - 1
Loop
If intIndex1 <= intIndex2 Then
Element1 = varArray(intIndex1, 1)
Element2 = varArray(intIndex1, 2)
varArray(intIndex1, 1) = varArray(intIndex2, 1)
varArray(intIndex1, 2) = varArray(intIndex2, 2)
varArray(intIndex2, 1) = Element1
varArray(intIndex2, 2) = Element2
intIndex1 = intIndex1 + 1
intIndex2 = intIndex2 - 1
End If
Loop Until intIndex1 > intIndex2
If Untergrenze < intIndex2 Then Call sortieren(Untergrenze, intIndex2, varArray)
If intIndex1 < Obergrenze Then Call sortieren(intIndex1, Obergrenze, varArray)
End Sub

Code eingefügt mit: Excel Code Jeanie

Ich hoffe du wohnst in der nähe von Nürnberg, jetzt sind langsam ein paar Biere fällig.
Gruß
Nepumuk

Option Explicit Public Sub Franz() Dim lngZeile As Long For lngZeile = 1 To Cells(65536, 4).End(xlUp).Row If Cells(lngZeile, 4) <> "" Then If IsNumeric(Cells(lngZeile, 4)) Then Cells(lngZeile, 4) = Cells(lngZeile, 4) * 1 End If Next End Sub

Beliebteste Forumthreads (12 Monate)

Kombobox füllen ohne doppelte Werte

17
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

318 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Kombobox füllen ohne doppelte Werte

17 Beiträge zum Forumthread Beiträge zu diesem Forumthread

318 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

17
Beiträge zum Forumthread

Beiträge zu diesem Forumthread