Option Explicit
 
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
 
Private Const LB_SETTABSTOPS = &H192
Private Feld()
 
Enum EnumFilter
  NoFilter
  GetAllNumbers
  GetFirstNumbers
  GetLastNumbers
End Enum
Dim DataAscending As Boolean
Dim Filterstil As EnumFilter
Dim x As Integer, y As Integer
 
Dim nTab() As Long
Dim v As Variant
 
Private Sub Sort(Data() As Variant, Ascending As Boolean, StringSort As EnumFilter)
  'Sortieren eines Variant-Datenfeldes
  'Data()     - zu sortierendes Datenfeld
  'Ascending  - aufsteigende Sortierung, falls True
  'StringSort - numerische Sortierung bei Zeichenketten
  Dim TempValue As Variant
  Dim Element As Long
  Dim Counter As Long
  
  For Element = LBound(Data) To UBound(Data)
    For Counter = Element + 1 To UBound(Data)
      If Ascending Then
         'absteigende Sortierung 3 > 2 > 1 ...
        If VarType(Data(Element)) = vbString _
              And StringSort <> NoFilter Then
            'numerische Teilinformationen vergleichen
          If Val(NumFilter$(CStr(Data(Element&)), StringSort)) < _
                Val(NumFilter$(CStr(Data(Counter&)), StringSort)) Then
              'und über diese teilwerte ggfs. Austausch der Gesamtinformationen vornehmen
            TempValue = Data(Element)
            Data(Element) = Data(Counter)
            Data(Counter) = TempValue
          End If
        Else
          If Data(Element&) < Data(Counter&) Then
            TempValue = Data(Element&)
            Data(Element&) = Data(Counter&)
            Data(Counter&) = TempValue
          End If
        End If
      End If
    Next Counter
  Next Element
End Sub
 
Private Function NumFilter(Text As String, Filterstyle As EnumFilter) As String
   'numerische Werte aus Zeichenketten herausfiltern
  Dim x As Long
  Dim Zeichen As String
  Dim Temp As String
  
  If Filterstyle = GetAllNumbers Then
      'alle numerischen Ziffern herausfiltern (123ABC456 = 123456)
    For x = 1 To Len(Text$)
      Zeichen$ = Mid$(Text$, x, 1)
      If Asc(Zeichen$) >= 48 And Asc(Zeichen$) <= 57 Then
        'Zeichen übernehmen
        Temp$ = Temp$ & Zeichen$
      End If
    Next x
  
  ElseIf Filterstyle = GetFirstNumbers Then
      'nur die Ziffern bis zum ersten Buchstaben herausfiltern (123ABC456 = 123)
    For x = 1 To Len(Text$)
      Zeichen$ = Mid$(Text$, x, 1)
      If Asc(Zeichen$) >= 48 And Asc(Zeichen$) <= 57 Then
         'Zeichen übernehmen
        Temp$ = Temp$ & Zeichen$
      Else
         'vorzeitiger Abbruch, falls bereits ein numerischer Wert ermittelt wurde und ein Buchstabe als Trenner erkannt wird
        If Temp$ <> "" Then Exit For
      End If
    Next x
  
  ElseIf Filterstyle = GetLastNumbers Then
      'nur Ziffern herausfiltern, die rechts innerhalb einer Zeichenkette vorhanden sind (Trennzeichen erster Buchstabe (123ABC456 = 456)
    For x = Len(Text$) To 1 Step -1
      Zeichen$ = Mid$(Text$, x, 1)
      If Asc(Zeichen$) >= 48 And Asc(Zeichen$) <= 57 Then
          'Zeichen übernehmen
        Temp$ = Zeichen$ & Temp$
      Else
          'vorzeitiger Abbruch, falls bereits ein numerischer Wert ermittelt wurde und ein Buchstabe als Trenner erkannt wird
        If Temp$ <> "" Then Exit For
      End If
    Next
  End If
  'Ergebniszeichenkette zurückliefern
  NumFilter$ = Temp$
End Function
 
Public Sub ListBox_SetTabStop(ByVal oList As Object, ParamArray vTabValue())
 Dim nCount As Long
 Dim id As Long
 
 nCount = UBound(vTabValue) + 1
 ReDim nTab(1 To nCount)
 For id = 1 To nCount
  nTab(id) = vTabValue(id - 1)
 Next
 SendMessage oList.hwnd, LB_SETTABSTOPS, nCount, nTab(1)
End Sub
 
Private Sub LblList_Click(Index As Integer)
 If Index = 0 Then
  ListBox_SetTabStop ListUnsort, 60, 60
  ListUnsort.AddItem TxtPoints.Text & vbTab & TxtName.Text
  TxtPoints.Text = "": TxtName.Text = "": TxtPoints.SetFocus
  
  If ListUnsort.ListIndex > 0 Then
   For y = 0 To ListUnsort.ListCount - 1
     Feld(y) = ListUnsort.List(y)
   Next
  End If
 
 Else
    
  DataAscending = False
  
  Sort Feld(), DataAscending, GetFirstNumbers
  For x% = 1 To 10
     'benutzerdefiniert sortiertes Datenfeld
    'Datenfeld plus interne Filterergebnisse
   Filterstil = GetFirstNumbers
   ListSort.AddItem NumFilter$(CStr(Feld(x%)), Filterstil)
  Next
 End If
End Sub