Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
604to608
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
604to608
604to608
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Code Listbox sortieren erweitern.

Code Listbox sortieren erweitern.
27.04.2005 07:23:37
Holger
Hallo zusammen,
habe in der Recherche hier, folgenden Code gefunden. Kann mir jemand helfen und mir sagen was ich tuen muss um diesen Code der eine 4-spaltige Listbox sortiert auf eine 6 bzw 8 spaltige Listbox zu erweitern:
Option Explicit

Private Sub CommandButton1_Click()
Dim strSpalte As String
Do
strSpalte = InputBox$("Welche Spalte?", "Eingabe")
strSpalte = Trim$(strSpalte)
If strSpalte = "" Then Exit Sub
If Len(strSpalte) = 1 And InStr(1, "1234", strSpalte) <> 0 Then Exit Do
MsgBox "Nur ganze Zahlen von 1 bis 4 zulässig.", 48, "Hinweis"
Loop
Call sortieren(0, ListBox1.ListCount - 1, CByte(strSpalte))
End Sub


Private Sub sortieren(lngUgrenze As Long, lngOgrenze As Long, bytSpalte As Byte)
Dim lngIndex1 As Long, lngIndex2 As Long, strElement As String
Dim strZwischenspeicher As String, bytIndex As Byte
lngIndex1 = lngUgrenze
lngIndex2 = lngOgrenze
strZwischenspeicher = ListBox1.List(((lngUgrenze + lngOgrenze) / 2) \ 1, bytSpalte - 1)
Do
Do While ListBox1.List(lngIndex1, bytSpalte - 1) < strZwischenspeicher
lngIndex1 = lngIndex1 + 1
Loop
Do While strZwischenspeicher < ListBox1.List(lngIndex2, bytSpalte - 1)
lngIndex2 = lngIndex2 - 1
Loop
If lngIndex1 <= lngIndex2 Then
For bytIndex = 0 To 3
strElement = ListBox1.List(lngIndex1, bytIndex)
ListBox1.List(lngIndex1, bytIndex) = ListBox1.List(lngIndex2, bytIndex)
ListBox1.List(lngIndex2, bytIndex) = strElement
Next
lngIndex1 = lngIndex1 + 1
lngIndex2 = lngIndex2 - 1
End If
Loop Until lngIndex1 > lngIndex2
If lngUgrenze < lngIndex2 Then Call sortieren(lngUgrenze, lngIndex2, bytSpalte)
If lngIndex1 < lngOgrenze Then Call sortieren(lngIndex1, lngOgrenze, bytSpalte)
End Sub

MfG
Holger Wächter

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Code Listbox sortieren erweitern.
27.04.2005 13:33:40
Piet
For bytIndex = 0 To 3 anpassen
AW: Code Listbox sortieren erweitern.
27.04.2005 15:23:03
Heiko
Hallo Holger,
ich hab mir da mal selbst was geschrieben, vielleicht hilft dir das.

Sub SortBox(cltBox As Control, intSpalten As Integer, intSpalte As Integer, booText As Boolean)
' So DIS 13.08.04
' cltBox     : Name der Listbox die sortiert werden soll.
' intSpalten : Wieviele Spalten sollen mit sortiert werden. Sollte der Anzahl der Spalten
'              in der Listbox entsprechen
' intSpalte  : Nach welcher Spalte soll sortiert werden.
' booText    : True = als Text, False = als Zahl.
'              Wenn Sie Sortierung nach Zahl angeben darf in der ganzen Spalte kein Text sein.
' Aufruf zum Beispiel so: ListBox1 mit 7 Spalten, Sortierung nach Spalte 1 Sortierordnung Text
' SortBox ListBox1, 7, 1, False
' Oder so    : Listbox17 mit 2 Spalten, Sortierung nach Spalte 2 Sortierordnung Zahlen
' SortBox ListBox17, 2, 2, True
Dim intLast As Integer, intNext As Integer, intCounter As Integer
Dim strTmp As String
Dim variLast As Variant, variNext As Variant
On Error GoTo Errorhandler
With cltBox
For intLast = 0 To .ListCount - 1
For intNext = intLast + 1 To .ListCount - 1
If booText = True Then
variLast = CStr(.List(intLast, intSpalte - 1))
variNext = CStr(.List(intNext, intSpalte - 1))
Else
variLast = CDbl(.List(intLast, intSpalte - 1))
variNext = CDbl(.List(intNext, intSpalte - 1))
End If
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:
MsgBox "In der Listbox Sortierung ist ein Fehler aufgetreten ! Bitte informieren Sie 'So'." & vbCr & vbCr & _
"Aufgetretender Fehler." & vbCr & _
"Fehlernummer = " & Err.Number & vbCr & _
"Fehlerbeschreibung = " & Err.Description & vbCr & _
"Fehlersource = " & Err.Source, vbCritical, " Meldung von Makro SortBox !"
End Sub

Gruß Heiko

PS: Rückmeldung wäre nett !
Anzeige
AW: Code Listbox sortieren erweitern.
29.04.2005 11:35:41
Holger
Danke,
das ist ein Code der super flexibel ist. Sowas suchte ich. Danke.
Sorry das ich mich erst heute melde.
MfG
Holger Wächter

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige