AW: Listbox, Combox sortieren
27.11.2009 12:29:39
fcs
Hall Nick und Mathias,
hier ein von mir aus dieser Quelle ( https://www.herber.de/forum/archiv/640to644/t643881.htm#643949
) leicht modifizierter Code zum Sortieren von per AddItem oder Array-Zuweisung für List erstellten Auswahllisten von Comboboxen und Listboxen.
Gruß
Franz
'modifizierter Code für ComboBox1_Lostfocus im Tabellenmodul
Private Sub ComboBox1_LostFocus()
Dim strValue As Variant, objBox As Object
'Eingegebener Wert, der noch nicht in Auswahliste ist, wird ergänzt
With Me.ComboBox1
If .ListIndex = -1 And .Value "" Then
strValue = .Value
.AddItem strValue
Set objBox = Me.ComboBox1
SortBox cltBox:=objBox, intSpalten:=1, intSpalte:=1, bytWie:=2
.Value = strValue
End If
End With
End Sub
'#### Code in einem allgemeinen Modul #####
'Original leicht modifiziert - cltBox als Object statt Control deklariert, so funktioniert es _
für List-/Comboboxen in Tabellen und Userforms
' Quelle Original: http: _
//www.herber.de/forum/archiv/640to644/t643881.htm#643949
Option Explicit
Sub SortBox(cltBox As Object, intSpalten As Integer, _
intSpalte As Integer, Optional bytWie As Byte = 1)
' So DIS 28.04.05 - modified fcs
' SortBox sortiert nicht gebundene List- und Comboboxen. Gebundene List- und Comboboxen
' (Angaben bei RowSource oder ListFillRange können nicht sortiert werden!!!)
' cltBox : Name der Listbox die sortiert werden soll (als Object!!!!).
' intSpalten : Wieviele Spalten sollen mit sortiert werden. Sollte der Anzahl der Spalten
' in der Listbox entsprechen
' intSpalte : Nach welcher Spalte soll sortiert werden.
' bytWie : 1 oder Nicht angegeben als Text
' : 2 als Zahl, dann muß die ganze Spalte Zahlen enthalten.
' : 3 als Datum, dann muß die ganze Spalte Datumwerte enthalten.
' Aufruf zum Beispiel so: ListBox1 mit 7 Spalten, Sortierung nach Spalte 1 Sortierordnung Text
' SortBox ListBox1, 7, 1 oder SortBox ListBox1, 7, 1, 1
' Oder so : Listbox17 mit 2 Spalten, Sortierung nach Spalte 2 Sortierordnung Zahlen
' SortBox ListBox17, 2, 2, 2
' oder so eine Spalte, sortiert nach Zahl
' SortBox cltBox:=objBox, intspalten:=1, intSpalte:=1, bytWie:=2
Dim intLast As Integer, intNext As Integer, intCounter As Integer, intFehler As Integer
Dim strTmp As String, strFehlertext As String
Dim variLast As Variant, variNext As Variant
On Error GoTo Errorhandler
intFehler = 0
With cltBox
For intLast = 0 To .ListCount - 1
For intNext = intLast + 1 To .ListCount - 1
Select Case bytWie
Case 1
intFehler = 0
variLast = CStr(.List(intLast, intSpalte - 1))
variNext = CStr(.List(intNext, intSpalte - 1))
Case 2
intFehler = 1
variLast = CDbl(.List(intLast, intSpalte - 1))
variNext = CDbl(.List(intNext, intSpalte - 1))
Case 3
intFehler = 2
variLast = CDate(.List(intLast, intSpalte - 1))
variNext = CDate(.List(intNext, intSpalte - 1))
End Select
intFehler = 0
If variLast > variNext Then
For intCounter = 0 To intSpalten - 1
strTmp = CStr(.List(intLast, intCounter))
.List(intLast, intCounter) = CStr(.List(intNext, intCounter))
.List(intNext, intCounter) = strTmp
Next intCounter
End If
Next intNext
Next intLast
End With
Exit Sub
Errorhandler:
Select Case intFehler
Case 0
strFehlertext = "In der Listbox Sortierung ist ein Fehler aufgetreten !"
Case 1
strFehlertext = "Nicht alle Werte in der zu sortierenden Spalte sind Zahlen !"
Case 2
strFehlertext = "Nicht alle Werte in der zu sortierenden Spalte sind Datumswerte !"
Case Else
strFehlertext = "Unerwarteter Fehler !"
End Select
MsgBox strFehlertext & " Bitte informieren Sie 'So' ! " & vbCr & vbCr & _
"Fehler aufgetreten in " & cltBox.Name & " !" & vbCr & _
"Fehlernummer = " & Err.Number & vbCr & _
"Fehlerbeschreibung = " & Err.Description & vbCr & _
"Fehlersource = " & Err.Source, vbCritical, " Meldung vom Makro SortBox !"
End Sub
