Dim entries() As String
ReDim entries(ListBox1.ListCount-1, ListBox1.ColumnCount-1)
For i = 0 To ListBox1.ListCount - 1
   For k = 0 To ListBox1.ColumnCount - 1
      entries(i, k) = ListBox1.List(i, k)
   Next k
Next i
 
'Array nach einer Spalte Sortieren: Quicksort
'http://www.vbarchiv.net/tipps/details.php?id=1881
 
For i = 0 To ListBox1.ListCount - 1
   For k = 0 To ListBox1.ColumnCount - 1
      ListBox1.List(i, k) = entries(i, k)
   Next k
Next i

'Sortierfunktion für Spalten einer Listbox
'columindex: Spaltenindex ab 1
'columntype: Datentyp Sortierspalte 0=string, 1=Double, 2=Date
Public Sub SortListbox(ByVal lbo As Msforms.ListBox, _
                       ByVal columnindex As Integer, _
                       ByVal columntype As Integer)
 
   Dim entries() As Variant
   With ListBox1
 
      ReDim entries(.ListCount - 1, .ColumnCount - 1)
      For i = 0 To .ListCount - 1
         For k = 0 To .ColumnCount - 1
            entries(i, k) = .List(i, k)
         Next k
      Next i
 
      Call QuickSortArray(entries, columnindex, columntype, _
                          0, .ListCount - 1)
 
      For i = 0 To .ListCount - 1
         For k = 0 To .ColumnCount - 1
           .List(i, k) = entries(i, k)
         Next k
      Next i
 
   End With
 
End Sub
 
' vSort: 2-dimensionales Array
' columnindex: Spalte, nach der sortiert werden soll (1, 2, 3, ...)
' columntype: Datentyp Sortierspalte 0=String, 1=Double, 2=Date
Public Sub QuickSortArray(vSort As Variant, _
  ByVal columnindex As Integer, ByVal columntype As Integer, _
  ByVal lngStart As Long, ByVal lngEnd As Long)
 
  Dim i As Long, j As Long
  Dim h As Variant, x As Variant
  Dim u As Long, lb_dim As Long, ub_dim As Long
 
  ' Anzahl Elemente pro Datenzeile
  lb_dim = LBound(vSort, 2)
  ub_dim = UBound(vSort, 2)
 
  i = lngStart: j = lngEnd
  x = vSort((lngStart + lngEnd) / 2, columnindex - 1)
 
  ' Array aufteilen
  Do
 
    While CompareEntries(columntype, vSort(i, columnindex - 1), x) = -1
      i = i + 1
    Wend
    While CompareEntries(columntype, vSort(j, columnindex - 1), x) = 1
      j = j - 1
    Wend
 
    If (i <= j) Then
      ' Wertepaare miteinander tauschen
      For u = lb_dim To ub_dim
        h = vSort(i, u)
        vSort(i, u) = vSort(j, u)
        vSort(j, u) = h
      Next u
      i = i + 1: j = j - 1
    End If
  Loop Until (i > j)
 
  If (lngStart < j) Then _
     QuickSortArray vSort, columnindex, columntype, lngStart, j
  If (i < lngEnd) Then _
     QuickSortArray vSort, columnindex, columntype, i, lngEnd
 
End Sub
 
Public Function CompareEntries(ByVal columntype As Integer, _
          ByVal e1 As Variant, ByVal e2 As Variant) As Integer
 
          If columntype = 0 Then
             If CStr(e1) > CStr(e2) Then
                CompareEntries = 1
             ElseIf CStr(e1) < CStr(e2) Then
                CompareEntries = -1
             Else
                CompareEntries = 0
             End If
          ElseIf columntype = 1 Then
             If CDbl(e1) > CDbl(e2) Then
                CompareEntries = 1
             ElseIf CDbl(e1) < CDbl(e2) Then
                CompareEntries = -1
             Else
                CompareEntries = 0
             End If
          Else
             If CDate(e1) > CDate(e2) Then
                CompareEntries = 1
             ElseIf CDate(e1) < CDate(e2) Then
                CompareEntries = -1
             Else
                CompareEntries = 0
             End If
          End If
End Function

Private Sub Form_Load()
 
  ListBox1.ColumnCount = 3
 
  'Listbox mit Zufallswerten füllen (String, Double, Date)
  Dim i As Integer
  With ListBox1
    For i = 1 To 1600
       AddItems ListBox1, "A" & CStr(Round(Rnd, 4)), _
       Round(100 * Rnd, 4), _
       Randomdate
    Next i
  End With
 
  'Sortieren (Control, Spaltenindex, Spaltentyp)
  Call SortListbox(ListBox1, 1, 0)
  'Call SortListbox(ListBox1, 2, 1)
  'Call SortListbox(ListBox1, 3, 2)
End Sub
 
Private Sub AddItems(lb As Msforms.ListBox, _
  Text1 As String, Text2 As String, Text3 As String)
  'Hilfsfunktion Listbox füllen
  lb.AddItem (Text1)
  lb.List(lb.ListCount - 1, 1) = Text2
  lb.List(lb.ListCount - 1, 2) = Text3
End Sub
 
Public Function Randomdate() As Date
   'Hilfsfunktion: Zufallsdatum
   Dim str As String
   str = CStr(CInt(Rnd * 27) + 1) & "." & _
            CStr(CInt(Rnd * 11) + 1) & ".2011"
   Randomdate = CDate(str)
End Function

'Sortierfunktion für Spalten einer Listbox
'columindex: Spaltenindex ab 1
'columntype: Datentyp Sortierspalte 0=String, 1=Double, 2=Date
'ascending:  Sortier-Richtung
Public Sub SortListbox(ByVal lbo As Msforms.ListBox, _
                       ByVal columnindex As Integer, _
                       ByVal columntype As Integer, _
              Optional ByVal ascending As Boolean = True)
 
   Dim entries() As Variant, i As Integer, k As Integer
   With ListBox1
      ReDim entries(.ListCount - 1, .ColumnCount - 1)
      entries = .Column
      Call QuickSortArray(entries, _
      columnindex, columntype, 0, .ListCount - 1, ascending)
      .Column = entries
   End With
End Sub
 
' vSort: 2-dimensionales Array
' columnindex: Spalte, nach der sortiert werden soll (1, 2, 3, ...)
' columntype: Datentyp Sortierspalte 0=String, 1=Double, 2=Date
' !!! Array-Dimensionen werden als Spalte * Zeile erwartet !!!
Public Sub QuickSortArray(vSort As Variant, _
  ByVal columnindex As Integer, ByVal columntype As Integer, _
  ByVal lngStart As Long, ByVal lngEnd As Long, _
  Optional ByVal ascending As Boolean = True)
 
  Dim i As Long, j As Long
  Dim h As Variant, x As Variant
  Dim u As Long, lb_dim As Long, ub_dim As Long
 
  ' Anzahl Elemente pro Datenzeile
  lb_dim = LBound(vSort, 1)
  ub_dim = UBound(vSort, 1)
 
  i = lngStart: j = lngEnd
  x = vSort(columnindex - 1, (lngStart + lngEnd) / 2)
 
  ' Array aufteilen
  Do
 
    While CompareEntries(columntype, ascending, vSort(columnindex - 1, i), x) = _
      -1
      i = i + 1
    Wend
    While CompareEntries(columntype, ascending, vSort(columnindex - 1, j), x) = _
      1
      j = j - 1
    Wend
 
    If (i <= j) Then
      ' Wertepaare miteinander tauschen
      For u = lb_dim To ub_dim
        h = vSort(u, i)
        vSort(u, i) = vSort(u, j)
        vSort(u, j) = h
      Next u
      i = i + 1: j = j - 1
    End If
  Loop Until (i > j)
 
  If (lngStart < j) Then _
     QuickSortArray vSort, columnindex, columntype, lngStart, j, ascending
  If (i < lngEnd) Then _
     QuickSortArray vSort, columnindex, columntype, i, lngEnd, ascending
 
End Sub
 
Public Function CompareEntries(ByVal columntype As Integer, _
          ByVal ascending As Boolean, _
          ByVal e1 As Variant, ByVal e2 As Variant) As Integer
 
          Dim bigger%, lower%
          If ascending Then
             bigger = 1: lower = -1
          Else
             bigger = -1: lower = 1
          End If
 
          CompareEntries = 0
 
          If columntype = 0 Then
             If CStr(e1) > CStr(e2) Then
                CompareEntries = bigger
             ElseIf CStr(e1) < CStr(e2) Then
                CompareEntries = lower
             End If
          ElseIf columntype = 1 Then
             If CDbl(e1) > CDbl(e2) Then
                CompareEntries = bigger
             ElseIf CDbl(e1) < CDbl(e2) Then
                CompareEntries = lower
             End If
          ElseIf columntype = 2 Then
             If CDate(e1) > CDate(e2) Then
                CompareEntries = bigger
             ElseIf CDate(e1) < CDate(e2) Then
                CompareEntries = lower
             End If
          Else
             If e1 > e2 Then
                CompareEntries = bigger
             ElseIf e1 < e2 Then
                CompareEntries = lower
             End If
          End If
End Function

'lbo: Listbox mit den zu filternden Einträgem
'ColumnIndex: Spaltenindex (ab 1), in der die zu prüfenden Werte stehen
'ColumnValue: Der Wert nach dem gesucht werden soll 
'Rückgabe: Array mit den gefilterten Daten
Private Function GetMatchedEntries(ByVal lbo As MsForms.ListBox, _
                            ByVal ColumnIndex As Integer, _
                            ByVal ColumnValue As Variant) As Variant()
 
 
   Dim entries() As Variant
   Dim matchedindices() As Integer, matchedentries() As Variant
 
   Dim i%, k%, l%
   entries = lbo.Column
   ReDim matchedindices(UBound(entries, 2))
   k = -1
   For i = 0 To UBound(entries, 2)
      If entries(ColumnIndex - 1, i) = ColumnValue Then
         k = k + 1
         matchedindices(k) = i
      End If
   Next i
   If k = -1 Then
      ReDim matchedentries(0, 0)
      GetMatchedEntries = matchedentries
      Exit Function
   End If
 
   ReDim matchedentries(UBound(entries, 1), k) As Variant
   For i = 0 To k
      For l = 0 To UBound(entries, 1)
         matchedentries(l, i) = entries(l, matchedindices(i))
      Next l
   Next i
 
  GetMatchedEntries = matchedentries
 
End Function
 
'Übertragung der Entries in eine Listbox  
Private Sub SetItems(lbo As MsForms.ListBox, entries() As Variant)
 
  Dim i%, k%
  With lbo
      .Clear
      .ColumnCount = UBound(entries, 1)
      For i = 0 To UBound(entries, 2)
        .AddItem entries(0, i)
        For k = 1 To UBound(entries, 1)
          On Error Resume Next
          .List(.ListCount - 1, k) = entries(k, i)
        Next k
      Next i
  End With
End Sub

Private Sub cmdSelect_Click()
   Dim matchedentries() As Variant
   matchedentries = GetMatchedEntries(ListBox1, 1, txtSelect.Text)
   If UBound(matchedentries, 1) > 0 Then
      SetItems ListBox2, matchedentries
   Else
      MsgBox "nichts gefunden"
   End If
End Sub