Tipp 0297 Numerisch/alphanumerisch sortieren
Autor/Einsender:
Datum:
  Detlev Schubert
27.12.2002
Entwicklungsumgebung:   VB 5
Wer eine alphanumerische Liste nach Nummern sortieren möchte, muss manuell nachhelfen, und die numerischen Bestandteile aus einer Zeichenkette filtern. Dazu werden die zu sortierenden Zeichenketten über ein Datenfeld verwaltet.
Leider verfügt VB nicht über eine universelle Sortierfunktion für Datenfelder, so dass die Funktion Sort die eigentliche Sortierarbeit übernimmt, und sowohl aufsteigend als auch absteigend sortieren kann.
 
Option Explicit

Private Feld(1 To 10)
Private DataAscending As Boolean

Enum EnumFilter
  NoFilter
  GetAllNumbers
  GetFirstNumbers
  GetLastNumbers
End Enum

Private Sub Form_Load()
  Dim x As Integer

  InitData

  For x = 1 To 10
    List1.AddItem Feld(x%)
  Next
End Sub

Private Sub InitData()
  Feld(1) = "2324abc3"
  Feld(2) = "324aaa1"
  Feld(3) = "24cde2"
  Feld(4) = "2agh9"
  Feld(5) = "23caa7"
  Feld(6) = "132kla6"
  Feld(7) = "557mna5"
  Feld(8) = "555man10"
  Feld(9) = "8988bcd4"
  Feld(10) = "4222feda8"
End Sub

Private Sub optSort_Click(Index As Integer)
  Dim DataAscending As Boolean

  Dim Filterstil As EnumFilter
  Dim x As Integer

  InitData

  List2.Clear
  List3.Clear

  If chkAscending = 1 Then
      DataAscending = True
    Else
      DataAscending = False
  End If

  Select Case Index
    Case 0
       'keine Sortierung
    Case 1
      Sort Feld(), DataAscending, NoFilter
    Case 2
      Sort Feld(), DataAscending, GetAllNumbers
    Case 3
      Sort Feld(), DataAscending, GetFirstNumbers
    Case 4
      Sort Feld(), DataAscending, GetLastNumbers
  End Select

  For x% = 1 To 10
    List2.AddItem Feld(x%)
    If Index > 1 Then
      Select Case Index
         Case 2: Filterstil = GetAllNumbers
         Case 3: Filterstil = GetFirstNumbers
         Case 4: Filterstil = GetLastNumbers
      End Select
      List3.AddItem NumFilter$(CStr(Feld(x%)), Filterstil)
    Else
      List3.AddItem Feld(x%)
    End If
  Next x
End Sub

Private Sub chkAscending_Click()
  Dim x As Integer

  If chkAscending = 1 Then
    DataAscending = True
  Else
    DataAscending = False
  End If

  For x% = 0 To 4
    If optSort(x).Value = True Then
      optSort_Click x
      Exit For
    End If
  Next x%
End Sub

Private Sub Sort(Data() As Variant, Ascending As Boolean, _
        StringSort As EnumFilter)

  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
        If VarType(Data(Element&)) = vbString And _
                StringSort <> NoFilter Then
          If Val(NumFilter$(CStr(Data(Element&)), StringSort)) > _
             Val(NumFilter$(CStr(Data(Counter&)), StringSort)) Then
            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
      Else
        If VarType(Data(Element)) = vbString _
              And StringSort <> NoFilter Then
          If Val(NumFilter$(CStr(Data(Element&)), StringSort)) < _
             Val(NumFilter$(CStr(Data(Counter&)), StringSort)) Then
            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

  Dim x As Long
  Dim Zeichen As String
  Dim Temp As String

  If Filterstyle = GetAllNumbers Then
    For x = 1 To Len(Text$)
      Zeichen$ = Mid$(Text$, x, 1)
      If Asc(Zeichen$) >= 48 And Asc(Zeichen$) <= 57 Then
        Temp$ = Temp$ & Zeichen$
      End If
    Next x

  ElseIf Filterstyle = GetFirstNumbers Then
    For x = 1 To Len(Text$)
      Zeichen$ = Mid$(Text$, x, 1)
      If Asc(Zeichen$) >= 48 And Asc(Zeichen$) <= 57 Then
        Temp$ = Temp$ & Zeichen$
      Else
        If Temp$ <> "" Then Exit For
      End If
    Next x

  ElseIf Filterstyle = GetLastNumbers Then
    For x = Len(Text$) To 1 Step -1
      Zeichen$ = Mid$(Text$, x, 1)
      If Asc(Zeichen$) >= 48 And Asc(Zeichen$) <= 57 Then
        Temp$ = Zeichen$ & Temp$
      Else
        If Temp$ <> "" Then Exit For
      End If
    Next
  End If

  NumFilter$ = Temp$
End Function
 

Betriebssystem/VB-Version
Win 9x
Win ME
Win NT
Win 2000
Win XP
Win Vista
VBA 5
VBA 6
VB 4/16
VB 4/32
VB 5
VB 6


Download  (4,1 kB) Downloads bisher: [ 1549 ]

Vorheriger Tipp Zum Seitenanfang Nächster Tipp

Startseite | Projekte | Tutorials | API-Referenz | VB-/VBA-Tipps | Komponenten | Bücherecke | VB/VBA-Forum | VB.Net-Forum | DirectX-Forum | Foren-Archiv | DirectX | VB.Net-Tipps | Chat | Spielplatz | Links | Suchen | Stichwortverzeichnis | Feedback | Impressum

Seite empfehlen Bug-Report
Letzte Aktualisierung: Samstag, 2. Juni 2007