PDA

Vollständige Version anzeigen : Listbox sortieren


Wasserholer
17.04.2009, 11:31
Hallo Forum,

wieder einmal probiere ich schon mehrere Tage, aber ich habe keine Lösung gefunden.
Für Euch Spezialisten ist das bestimmt ein Klacks.

Aus einer Tabelle werden innerhalb eines definierten Zeitraumes Daten mit den relevanten Terminen in einer Listbox angezeigt. Das funktioniert wunderbar.
Nun möchte ich aber, dass die Listbox nach dem Datum sortiert wird. Auch das habe ich aus Forumsbeiträgen hin bekommen. Allerdings werden die Listboxsätze nur ordnungsgemäß sortiert, wenn alle Termine unterschiedlich sind. Gibt es mehrere gleiche Termine, wird nur das Datum richtig sortiert. Die folgenden Spalten werden in eigener Sortierfolge gelistet.

Wie kann ich bei Vorhandensein gleicher Termine die Listboxsätze geschlossen in ihrer Zusammengehörigkeit sortieren? Ein Beispiel füge ich bei. Die Lösung über eine temporäre Tabelle strebe ich nicht an.

Gruß
Wasserholer

jinx
17.04.2009, 15:22
Moin, Wasserholer,

ohne mir die Mappe angesehen zu haben, denke ich, dass die Lösung über eine Collection zu erreichen wäre, wo zuerst die Daten zusammengefasst (in einem String) an die Collection übergeben werden, um abschließend zum Einlesen in die Listbox durch die Verwendung von SPLIT wieder aufgeteilt zu werden. Als Ansatz könnte der folgende Code dienen:

Sub CollEindeutigeWerteSortieren(strBereich As String, strTabelle As String, varSuche As Variant)

Dim rngBereich As Range
Dim rngZelle As Range
Dim myColl As Collection
Dim lngZähler As Long
Dim lngLetzteZeile As Long
Dim strRngVal As String

Const cstrSTARTWERT As String = "Testwert"

Set myColl = New Collection

myColl.Add Item:=cstrSTARTWERT, Key:=cstrSTARTWERT

Select Case strTabelle
Case "Einlagerung"
Set rngBereich = Sheets("Lagerplatz").Range(strBereich).SpecialCells(xlCellTypeBlanks)
On Error Resume Next
For Each rngZelle In rngBereich
If rngZelle.Value = varSuche Then
strRngVal = "Platz " & Format(rngZelle.Row - 1, "00") & " - Ebene " & rngZelle.Column - 1
For lngZähler = 1 To myColl.Count
If strRngVal < myColl(lngZähler) Then
myColl.Add Item:=strRngVal, Key:=strRngVal, Before:=lngZähler
End If
Next
myColl.Add Item:=strRngVal, Key:=strRngVal
End If
Next rngZelle
On Error GoTo 0
Case "Auslagerung"
Set rngBereich = Sheets("Lagerplatz").Range(strBereich).SpecialCells(xlCellTypeConstants, 2)
On Error Resume Next
For Each rngZelle In rngBereich
If Left(rngZelle.Value, 4) = varSuche Then
strRngVal = Mid(rngZelle.Value, 9) & " P.: " & Format(rngZelle.Row - 1, "00") & " - E.: " & rngZelle.Column - 1
For lngZähler = 1 To myColl.Count
If strRngVal < myColl(lngZähler) Then
myColl.Add Item:=strRngVal, Key:=strRngVal, Before:=lngZähler
End If
Next
myColl.Add Item:=strRngVal, Key:=strRngVal
End If
Next rngZelle
On Error GoTo 0
Case Else
MsgBox "Tabellenname " & strTabelle & " ist nicht vorgesehen.", vbExclamation, "Abbruch"
End
End Select

Set rngBereich = Nothing

myColl.Remove cstrSTARTWERT

For lngZähler = 1 To myColl.Count
Sheets(strTabelle).ListBox1.AddItem myColl(lngZähler)
Next lngZähler

End Sub
Aufruf:
Private Sub Worksheet_Change(ByVal Target As Range)

Dim rngCell As Range

If Not Intersect(Target, Range("B3")) Is Nothing Then
ActiveSheet.ListBox1.Clear
CollEindeutigeWerteSortieren "B2:F41", "Auslagerung", Target.Value
End If

End Sub

Wasserholer
17.04.2009, 18:25
Hallo jinx,

auf Deinen Beitrag hin melde ich mich noch. Erst einmal vielen Dank.

Ich versuche zunächst noch hinter die Funktionsweise Deines Makros zu steigen.
Als Ergebnis der letzten Stunden weiß ich inzwischen was NEW COLLECTION ist, verstehe aber nicht damit umzugehen.
Deinen Vorschlag versuche ich nachzuvollziehen, kann aber wohl jetzt schon sagen, dass es aus verschiedenen Gründen nicht meine Lösung werden wird.

Besten Gruß
Wasserholer

Wasserholer
17.04.2009, 22:41
Hallo jinx,

viel probiert und endlich geschafft.
Die Lösung ist so einfach, aber ich hatte mich immer wieder in den Schleifen verheddert. Das fertige Beispiel hänge ich an.

Beste Grüße
Wasserholer