ComboBox sortieren

Sub Combo_sortiert() If ComboBox1.ListCount = 0 Then Exit Sub Dim ArrSort() As Variant, i As Long ReDim ArrSort(ComboBox1.ListCount - 1) ''Daten erstmal in Array einlesen For i = 0 To ComboBox1.ListCount - 1 ArrSort(i) = ComboBox1.List(i) Next ''Combobox löschen Me.ComboBox1.Clear ''Sortierung aufrufen Call Sortierung(ArrSort) 'wenn aufsteigend ''Combobox mit sortierten Daten füllen ComboBox1.List() = ArrSort ''Ersten Eintrag auswählen ComboBox1.ListIndex = 0 End Sub

Sub Sortierung(ByRef arr() As Variant) Dim UB As Long, i As Long, tmp As Variant UB = UBound(arr) Do For i = 0 To UB - 1 If arr(i) > arr(i + 1) Then tmp = arr(i) arr(i) = arr(i + 1) arr(i + 1) = tmp End If Next UB = UB - 1 Loop While UB > 1 End Sub Diese funktioniert bei mir aber leider nicht, an der Stelle ComboBox1.Clear gibt es eine _ Fehlermeldung und wenn ich diesen Teil rausnehme, gibt er mir an der Stelle: ComboBox1.List() = ArrSort die Fehlermeldung "Permission denied" Ich wäre wirklich überaus dankbar wenn mir jemand diesbezüglich aus der Patsche helfen könnte! Vielen Dank

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub CboArtderBewertungFuellenD() Dim lngx As Long CboArtderBewertung.Clear Worksheets("SAB").Activate For lngx = 18 To Range("B65536").End(xlUp).Row If WorksheetFunction.CountIf(Range("B1:B" & lngx), Cells(lngx, 2)) = 1 Then Me.CboArtderBewertung.AddItem Cells(lngx, 2) End If Next Worksheets("Readme").Activate End Sub

Public Sub Sort_A_Z(SortArray, L, R) ' sortieren von A bis Z ' von GerdZ Herber.de Dim I, J, x, y I = L J = R x = SortArray((L + R) / 2) While (I x And I SortArray(J) And J > L) J = J - 1 Wend If (I

Hallo
Lösche die Rowsource in deiner Combobox und füge diese beiden Anweisungen in ein Modul !!

Option Explicit

'In ein Modul
Public sendArr() As Variant
Public getArr() As Variant

und das in deine Userform.
Darauf achten dass ein Button Commandbutton1 vorhanden ist, ansonsten in den entsprechenden Button kopieren oder in das Userform_Initialize Ereignis

Option Explicit

Private Sub CommandButton1_Click()
    Dim i As Long, tarCol As Long, startRow As Long, lastRow As Long
    'Startzeile wo die Daten beginnen
    startRow = 1
    'Spalte wo die Daten stehen
    '1 = A, 2 = B usw.
    tarCol = 1
    '*****************
    'Nichts mehr anpassen oder ändern
    'ausser dem Namen der Combobox
    'Letzter Eintrag in dieser Spalte berechnen
    lastRow = Cells(Rows.Count, tarCol).End(xlUp).Row
    ReDim sendArr((lastRow - startRow) + 1)
    ''Daten erstmal in Array einlesen
    For i = startRow To lastRow
        sendArr(i - 1) = Cells(i, 1)
    Next
    ''Combobox löschen
    Me.ComboBox1.Clear
    ''Sortierung aufrufen
    Call Sortierung(sendArr)
    ''Combobox mit sortierten Daten füllen
    Me.ComboBox1.List() = getArr
    ''Ersten Eintrag auswählen
    Me.ComboBox1.ListIndex = 0
End Sub

Private Sub Sortierung(tmpArr() As Variant)
    Dim lastArr As Long, i As Long, tmp As Variant
    Dim arrList As Long
    lastArr = UBound(tmpArr)
    Do
        For i = 0 To lastArr - 1
            If tmpArr(i) > tmpArr(i + 1) Then
                tmp = tmpArr(i)
                tmpArr(i) = tmpArr(i + 1)
                tmpArr(i + 1) = tmp
            End If
        Next
        lastArr = lastArr - 1
    Loop While lastArr > 1
    lastArr = UBound(tmpArr)
    arrList = 0
    ReDim Preserve getArr(arrList)
    For i = 0 To lastArr
        If tmpArr(i) <> "" Then
            getArr(arrList) = tmpArr(i)
            arrList = arrList + 1
            ReDim Preserve getArr(arrList)
        End If
    Next i
End Sub

Gruss Rainer

Function HoleStichtag(strCode As String) As String Dim rgZelle As Range Dim rgBereich As Range Dim dblZeit As String Set rgBereich = Worksheets("VKW").Range("A18:A500") For Each rgZelle In rgBereich If rgZelle.Value = strCode Then dblZeit = rgZelle.Offset(0, 2) Me.CboWertermittlungsstichtag.AddItem dblZeit End If Next End Function

Hallo Rainer!
Leider funktioniert das Ganze so nicht. In meiner Combobox befinden sich jetzt diverse Werte, teilweise Objektnummern, teilweise Stichtagsdaten. Habe das ganze angepasst, so wie du es vorgeschlagen hast, also folgendermaßen:
Sub CboWertermittlungsstichtagFuellen()
Dim lngx As Long
CboWertermittlungsstichtag.Clear
HoleStichtag (Me.CboObjektListe.Value)
'Bis hier ist die Combobox noch mit den richtigen Werten gefüllt
Comboinarray
End Sub

Function HoleStichtag(strCode As String) As String
Dim rgZelle As Range
Dim rgBereich As Range
Dim dblZeit As String
Set rgBereich = Worksheets("VKW").Range("A18:A500")
For Each rgZelle In rgBereich
If rgZelle.Value = strCode Then
dblZeit = rgZelle.Offset(0, 2)
Me.CboWertermittlungsstichtag.AddItem dblZeit
End If
Next
End Function

Sub Comboinarray()
Dim startCmb As Long
Dim endCmb As Long
startCmb = 0
endCmb = Me.CboWertermittlungsstichtag.ListCount - 1
For i = startCmb To endCmb
sendArr(i) = Me.CboWertermittlungsstichtag.List(i)
Next
''Combobox löschen
Me.CboWertermittlungsstichtag.Clear
''Sortierung aufrufen
Call CboSortierung(sendArr)
''Combobox mit sortierten Daten füllen
Me.CboWertermittlungsstichtag.List() = getArr
Me.CboWertermittlungsstichtag.ListIndex = 0
End Sub


Private Sub CboSortierung(tmpArr() As Variant)
Dim lastArr As Long, i As Long, tmp As Variant
Dim arrList As Long
lastArr = UBound(tmpArr)
Do
For i = 0 To lastArr - 1
If tmpArr(i) > tmpArr(i + 1) Then
tmp = tmpArr(i)
tmpArr(i) = tmpArr(i + 1)
tmpArr(i + 1) = tmp
End If
Next
lastArr = lastArr - 1
Loop While lastArr > 1
lastArr = UBound(tmpArr)
arrList = 0
ReDim Preserve getArr(arrList)
For i = 0 To lastArr
If tmpArr(i)  "" Then
getArr(arrList) = tmpArr(i)
arrList = arrList + 1
ReDim Preserve getArr(arrList)
End If
Next i
End Sub

Vorher stehen in der Combobox definitiv nur Stichtagsdaten drin, daher kann ich mir nicht so wirklich erklären, wie durch Auslesen in ein Array jetzt plötzlich noch Objektnummern und einige (falsche) Stichtage dazukommen.
Falls das Ganze an dieser Stelle zu kompliziert wird, ist das auch nicht tragisch. Dann lasse ich die Daten einfach unsortiert. Vielleicht fällt dir ja trotzdem etwas ein!?
Etwas anderes, was mir viel wichtiger ist, ist mir allerdings auch noch aufgefallen:
Die anderen Comboboxen, die ich mit Hilfe deiner Sortierfunktion befüllt habe, enthalten am Ende immer noch einen leeren Eintrag. Wie bekomme ich diesen raus? Da mit den Werten aus der Combobox weitergerechnet wird kommt bei Anklicken des leeren Eintrags eine Fehlermeldung, was doch sehr unschön ist. Daher wäre es mir sehr wichtig, diesen "Leereintrag" wegzubekommen.
Ich hoffe ich überfordere dich nicht zu sehr und bin gespannt auf deine Antwort.
Tausend Dank schon einmal im Vorhinein!
Gruß Sebastian

Beliebteste Forumthreads (12 Monate)

16
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

ComboBox sortieren

16 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

16
Beiträge zum Forumthread

Beiträge zu diesem Forumthread