====== Sortieren von Texten ======

Die zum alphanumerischen Sortieren wohl bekannteste Routine dürfte "QuickSort" sein, eine rekursive und daher sehr schnelle Anwendung. Man muss nur die zu sortierenden Texte in ein eindimensionales Array übertragen und dann "QuickSort" mit dem Array und Unter- und Obergrenze des Arrays aufrufen. Soll das ganze Array sortiert werden, was der Normalfall sein dürfte, reicht es für Ober- und Untergrenze jeweils "" einzutragen. Nach dem Durchlauf stehen die Texte in sortierter Reihenfolge im Array zur Verfügung.\\ \\ Mit dem folgenden Skriptbeispiel wird ein Dialog aufgerufen, der die Eingabe beliebiger Texte erlaubt, bzw. wo man über einen Button einen Beispieltext aufrufen kann. Nach Mausklick auf "Sortieren" werden diese Texte im Ergebnisfenster sortiert angezeigt.

{{::sortieren.gif?nolink|}}

===== Sortieren (vbs) =====

<code VBScript [enable_line_numbers="true"]>
  'FFSubmenu=Test
  'FFName=Sortieren

  'Demo Sortieren von Texten
  Option Explicit

  Dim ListenArray,Ergebnis,Abbruch
  '------------------------------------------------------------------------
  call main
  '------------------------------------------------------------------------
  Sub main

  '** Start Dialog Demo Sortieren **
  FF_AddDialog "Demo Sortieren",145,98
  FF_AddControl "Demo Sortieren","Eingabe","STATIC",5,1,65,10
  FF_SetControlStyle "Demo Sortieren","Eingabe",1
  FF_AddControl "Demo Sortieren","UrListe","EDIT",5,12,65,65
  FF_AddControl "Demo Sortieren","Ergebnis","STATIC",75,1,65,10
  FF_SetControlStyle "Demo Sortieren","Ergebnis",1
  FF_AddControl "Demo Sortieren","SortListe","EDIT",75,12,65,65
  FF_SetControlStyle "Demo Sortieren","SortListe",2048
  FF_AddControl "Demo Sortieren","Beipieltext laden","BUTTON",14,84,48,9
  FF_AddControl "Demo Sortieren","Sortieren","BUTTON",92,82,33,11
  '** End Dialog Demo Sortieren **

  do
     Abbruch = false
     Select Case FF_ShowDialog ("Demo Sortieren")
     Case "CANCEL"
        exit do
     Case "Beipieltext laden"
        FF_SetControl "Demo Sortieren","UrListe", "" & _
           "Ölgemälde" & vbCrLf & "gemeinsam" & vbCrLf & "Äxte" & vbCrLf & "Wehmut" & vbCrLf & "danken" & vbCrLf & _
           "Birnbaum" & vbCrLf & "Übelkeit" & vbCrLf & "zerreißen" & vbCrLf & "tanken" & vbCrLf & "Geruch"
     Case "Sortieren"
        call Vorbereitung
        if not Abbruch then
           call QuickSort(ListenArray,"","")
           Ergebnis = join(ListenArray,vbNewLine)
           FF_SetControl "Demo Sortieren","SortListe",Ergebnis
        end if
     End Select
  loop

  FF_CloseDialog ("Demo Sortieren")

  End Sub
  '------------------------------------------------------------------------
  Sub Vorbereitung
  Dim Text

  Text = FF_GetControl ("Demo Sortieren","UrListe")
  if len(Text) = 0 then
     msgbox "Es wurde kein Text eingegeben!",vbInformation,"Hinweis"
     Abbruch = true
     exit sub
  end if

  ListenArray = split(Text,vbNewLine)

  End Sub
  '------------------------------------------------------------------------
  Sub QuickSort(vSort,ByVal lngStart,ByVal lngEnd)
  '### Sortieren des Arrays 'vSort' nach ASCII-Werten

  Dim i,j,h,x

  if lngStart = "" then lngStart = 0
  if lngEnd = "" then lngEnd = ubound(vSort)

  i = lngStart : j = lngEnd
  x = vSort((lngStart + lngEnd) / 2)

  '# Array aufteilen
  Do
     While (vSort(i) < x): i = i + 1: Wend
     While (vSort(j) > x): j = j - 1: Wend

     If (i <= j) Then
        '# Wertepaare miteinander tauschen
        h = vSort(i)
        vSort(i) = vSort(j)
        vSort(j) = h
        i = i + 1: j = j - 1
     End If
  Loop Until (i > j)

  '# Rekursion
  If (lngStart < j) Then call QuickSort(vSort,lngStart,j)
  If (i < lngEnd) Then call QuickSort(vSort,i,lngEnd)

  End Sub
  '------------------------------------------------------------------------
</code>
   
Wie man am Sortierergebnis des Beispieltextes sehen kann, erfolgt die Sortierung nach ASCII-Werten. Das hat zur Folge, dass erst nach Großbuchstaben, dann nach Kleinbuchstaben und zum Schluss nach Umlauten sortiert wird.

Wünschenswert ist natürlich, dass unabhängig von Groß- und Kleinschreibung sortiert wird und die Umlaute Ä, Ö, Ü bzw. ä, ö, ü wie Ae, Oe, Ue bzw. ae, oe, ue behandelt werden. Um letzteres zu erreichen, zumindest jeweils für den Anfangsbuchstaben eines Textes, kann man als Vorbereitung zum Sortieren die Umlaute bei den Anfangsbuchstaben entsprechend ersetzen und den Originalumlaut zur späteren Rekonstruktion mit einem Trennzeichen dem Text anhängen. Anschließend werden noch alle Texte in Großbuchstaben gewandelt.

Nach dem Sortieren werden in der Rekonstruktionsroutine die Texte mit Trennzeichen gesucht und die Umlaute wieder hergestellt. Dann wird für jeden Text der Ursprungstext gesucht und dieser mit der ursprünglichen Groß- und Kleinschreibung wieder eingesetzt.

===== Sortieren+ (vbs) =====
<code VBScript [enable_line_numbers="true"]>
  'FFSubmenu=Test
  'FFName=Sortieren+

  'Demo Sortieren von Texten
  Option Explicit

  Dim UrListenArray,ListenArray,Ergebnis,Abbruch
  const TZ = "|"   'Trennzeichen zur Kennzeichnung von Umlauten
  '------------------------------------------------------------------------
  call main
  '------------------------------------------------------------------------
  Sub main

  '** Start Dialog Demo Sortieren **
  FF_AddDialog "Demo Sortieren",145,98
  FF_AddControl "Demo Sortieren","Eingabe","STATIC",5,1,65,10
  FF_SetControlStyle "Demo Sortieren","Eingabe",1
  FF_AddControl "Demo Sortieren","UrListe","EDIT",5,12,65,65
  FF_AddControl "Demo Sortieren","Ergebnis","STATIC",75,1,65,10
  FF_SetControlStyle "Demo Sortieren","Ergebnis",1
  FF_AddControl "Demo Sortieren","SortListe","EDIT",75,12,65,65
  FF_SetControlStyle "Demo Sortieren","SortListe",2048
  FF_AddControl "Demo Sortieren","Beipieltext laden","BUTTON",17,83,44,9
  FF_AddControl "Demo Sortieren","Sortieren","BUTTON",102,82,33,11
  '** End Dialog Demo Sortieren **

  do
     Abbruch = false
     Select Case FF_ShowDialog ("Demo Sortieren")
     Case "CANCEL"
        exit do
     Case "Beipieltext laden"
        FF_SetControl "Demo Sortieren","UrListe", "" & _
           "Ölgemälde" & vbCrLf & "gemeinsam" & vbCrLf & "Äxte" & vbCrLf & "Wehmut" & vbCrLf & "danken" & vbCrLf & _
           "Birnbaum" & vbCrLf & "Übelkeit" & vbCrLf & "zerreißen" & vbCrLf & "tanken" & vbCrLf & "Geruch"
     Case "Sortieren"
        call Vorbereitung
        if not Abbruch then
           call QuickSort(ListenArray,"","")
           call Rekonstruktion
           Ergebnis = join(ListenArray,vbNewLine)
           FF_SetControl "Demo Sortieren","SortListe",Ergebnis
        end if
     End Select
  loop

  FF_CloseDialog ("Demo Sortieren")

  End Sub
  '------------------------------------------------------------------------
  Sub Vorbereitung
  Dim Text,n,UL,ULn

  Text = FF_GetControl ("Demo Sortieren","UrListe")
  if len(Text) = 0 then
     msgbox "Es wurde kein Text eingegeben!",vbInformation,"Hinweis"
     Abbruch = true
     exit sub
  end if

  UrListenArray = split(Text,vbNewLine) 'Sicherung des Ursprungs
  ListenArray = split(Text,vbNewLine)

  '### Umlautkorrektur für das erste Zeichen
  for n = 0 to UBound(ListenArray)
     UL = left(ListenArray(n),1)
     if instr("ÖÄÜöäü",UL) > 0 then
        select case UL
           case "Ä","ä" : ULn = "Ae"
           case "Ö","ö" : ULn = "Oe"
           case "Ü","ü" : ULn = "Ue"
        case else
        end select
        ListenArray(n) = ULn & mid(ListenArray(n),2) & TZ & UL
     end if

     '### String in Großbuchstaben umwandeln
     ListenArray(n) = ucase(ListenArray(n))
  next

  End Sub
  '------------------------------------------------------------------------
  Sub Rekonstruktion
  Dim n,pos,element

  '### Umlaute wieder zurück setzen
  for n = 0 to UBound(ListenArray)
     pos = instr(ListenArray(n),TZ)
     if pos > 0 then
        ListenArray(n) = right(ListenArray(n),1) & mid(ListenArray(n),3,pos-3)
     end if

     '### ursprüngliche Groß- und Kleinschreibung wieder herstellen
     for each element in UrListenArray
        if ListenArray(n) = ucase(element) then ListenArray(n) = element :   exit for
     next
  next

  End Sub
  '------------------------------------------------------------------------
  Sub QuickSort(vSort,ByVal lngStart,ByVal lngEnd)
  '### Sortieren des Arrays 'vSort' nach ASCII-Werten

  Dim i,j,h,x

  if lngStart = "" then lngStart = 0
  if lngEnd = "" then lngEnd = ubound(vSort)

  i = lngStart : j = lngEnd
  x = vSort((lngStart + lngEnd) / 2)

  '# Array aufteilen
  Do
     While (vSort(i) < x): i = i + 1: Wend
     While (vSort(j) > x): j = j - 1: Wend

     If (i <= j) Then
        '# Wertepaare miteinander tauschen
        h = vSort(i)
        vSort(i) = vSort(j)
        vSort(j) = h
        i = i + 1: j = j - 1
     End If
  Loop Until (i > j)

  '# Rekursion
  If (lngStart < j) Then call QuickSort(vSort,lngStart,j)
  If (i < lngEnd) Then call QuickSort(vSort,i,lngEnd)

  End Sub
  '------------------------------------------------------------------------
</code>
   
Auch Zahlen werden richtig sortiert, wie man ausprobieren kann. Allerdings werden die Zahlen wie Text behandelt. 1,35,2,17 ergibt sortiert 1,17,2,35, wo hingegen bei 01, 35, 02, 17 die gewünschte Reihenfolge 01, 02, 17, 35 angezeigt wird. Bei Zahlen muss also auf immer gleiche Stellenzahl geachtet und vorlaufende Stellen entsprechen mit Nullen aufgefüllt werden.

===== Mehrdimensionales Feld sortieren =====

<code VBScript [enable_line_numbers="true"]>
  Sub QuickSortMultiDim(vSort, index, lngStart, lngEnd)
      ' sortiert ein zweidimensionales Feld nach einem anzugebenden Index (Spalte)
      ' vSort -> zweidimensionales Array
      ' index -> Spalte, nach der sortiert werden soll (1, 2, 3, ...)
       Dim i, j, h, x, u, lb_dim, ub_dim
      ' Wird die Bereichsgrenze mit "" angegeben, wird das gesamte Array sortiert
      if lngStart = "" then lngStart = 0
      if lngEnd = "" then lngEnd = ubound(vSort)
      ' Wird Index mit "" angegeben, wird nach der ersten Spalte sortiert
      if index = "" then index = 1

      ' Anzahl Elemente pro Datenzeile
      lb_dim = LBound(vSort, 2)
      ub_dim = UBound(vSort, 2)

      i = lngStart
      j = lngEnd
      x = vSort((lngStart + lngEnd) / 2, index - 1)

      ' Array aufteilen
      Do
          While (vSort(i, index - 1) < x): i = i + 1: Wend
          While (vSort(j, index - 1) > x): 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
              i = i + 1: j = j - 1
          End If
      Loop Until (i > j)

    ' Rekursion (Funktion ruft sich selbst auf)
    If (lngStart < j) Then QuickSortMultiDim vSort, index, lngStart, j
    If (i < lngEnd) Then QuickSortMultiDim vSort, index, i, lngEnd
  End Sub
</code>