meta data for this page

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 (vbs)

  1.   'FFSubmenu=Test
  2.   'FFName=Sortieren
  3.  
  4.   'Demo Sortieren von Texten
  5.   Option Explicit
  6.  
  7.   Dim ListenArray,Ergebnis,Abbruch
  8.   '------------------------------------------------------------------------
  9.   call main
  10.   '------------------------------------------------------------------------
  11.   Sub main
  12.  
  13.   '** Start Dialog Demo Sortieren **
  14.   FF_AddDialog "Demo Sortieren",145,98
  15.   FF_AddControl "Demo Sortieren","Eingabe","STATIC",5,1,65,10
  16.   FF_SetControlStyle "Demo Sortieren","Eingabe",1
  17.   FF_AddControl "Demo Sortieren","UrListe","EDIT",5,12,65,65
  18.   FF_AddControl "Demo Sortieren","Ergebnis","STATIC",75,1,65,10
  19.   FF_SetControlStyle "Demo Sortieren","Ergebnis",1
  20.   FF_AddControl "Demo Sortieren","SortListe","EDIT",75,12,65,65
  21.   FF_SetControlStyle "Demo Sortieren","SortListe",2048
  22.   FF_AddControl "Demo Sortieren","Beipieltext laden","BUTTON",14,84,48,9
  23.   FF_AddControl "Demo Sortieren","Sortieren","BUTTON",92,82,33,11
  24.   '** End Dialog Demo Sortieren **
  25.  
  26.   do
  27.      Abbruch = false
  28.      Select Case FF_ShowDialog ("Demo Sortieren")
  29.      Case "CANCEL"
  30.         exit do
  31.      Case "Beipieltext laden"
  32.         FF_SetControl "Demo Sortieren","UrListe", "" & _
  33.            "Ölgemälde" & vbCrLf & "gemeinsam" & vbCrLf & "Äxte" & vbCrLf & "Wehmut" & vbCrLf & "danken" & vbCrLf & _
  34.            "Birnbaum" & vbCrLf & "Übelkeit" & vbCrLf & "zerreißen" & vbCrLf & "tanken" & vbCrLf & "Geruch"
  35.      Case "Sortieren"
  36.         call Vorbereitung
  37.         if not Abbruch then
  38.            call QuickSort(ListenArray,"","")
  39.            Ergebnis = join(ListenArray,vbNewLine)
  40.            FF_SetControl "Demo Sortieren","SortListe",Ergebnis
  41.         end if
  42.      End Select
  43.   loop
  44.  
  45.   FF_CloseDialog ("Demo Sortieren")
  46.  
  47.   End Sub
  48.   '------------------------------------------------------------------------
  49.   Sub Vorbereitung
  50.   Dim Text
  51.  
  52.   Text = FF_GetControl ("Demo Sortieren","UrListe")
  53.   if len(Text) = 0 then
  54.      msgbox "Es wurde kein Text eingegeben!",vbInformation,"Hinweis"
  55.      Abbruch = true
  56.      exit sub
  57.   end if
  58.  
  59.   ListenArray = split(Text,vbNewLine)
  60.  
  61.   End Sub
  62.   '------------------------------------------------------------------------
  63.   Sub QuickSort(vSort,ByVal lngStart,ByVal lngEnd)
  64.   '### Sortieren des Arrays 'vSort' nach ASCII-Werten
  65.  
  66.   Dim i,j,h,x
  67.  
  68.   if lngStart = "" then lngStart = 0
  69.   if lngEnd = "" then lngEnd = ubound(vSort)
  70.  
  71.   i = lngStart : j = lngEnd
  72.   x = vSort((lngStart + lngEnd) / 2)
  73.  
  74.   '# Array aufteilen
  75.   Do
  76.      While (vSort(i) < x): i = i + 1: Wend
  77.      While (vSort(j) > x): j = j - 1: Wend
  78.  
  79.      If (i <= j) Then
  80.         '# Wertepaare miteinander tauschen
  81.         h = vSort(i)
  82.         vSort(i) = vSort(j)
  83.         vSort(j) = h
  84.         i = i + 1: j = j - 1
  85.      End If
  86.   Loop Until (i > j)
  87.  
  88.   '# Rekursion
  89.   If (lngStart < j) Then call QuickSort(vSort,lngStart,j)
  90.   If (i < lngEnd) Then call QuickSort(vSort,i,lngEnd)
  91.  
  92.   End Sub
  93.   '------------------------------------------------------------------------

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)

  1.   'FFSubmenu=Test
  2.   'FFName=Sortieren+
  3.  
  4.   'Demo Sortieren von Texten
  5.   Option Explicit
  6.  
  7.   Dim UrListenArray,ListenArray,Ergebnis,Abbruch
  8.   const TZ = "|"   'Trennzeichen zur Kennzeichnung von Umlauten
  9.   '------------------------------------------------------------------------
  10.   call main
  11.   '------------------------------------------------------------------------
  12.   Sub main
  13.  
  14.   '** Start Dialog Demo Sortieren **
  15.   FF_AddDialog "Demo Sortieren",145,98
  16.   FF_AddControl "Demo Sortieren","Eingabe","STATIC",5,1,65,10
  17.   FF_SetControlStyle "Demo Sortieren","Eingabe",1
  18.   FF_AddControl "Demo Sortieren","UrListe","EDIT",5,12,65,65
  19.   FF_AddControl "Demo Sortieren","Ergebnis","STATIC",75,1,65,10
  20.   FF_SetControlStyle "Demo Sortieren","Ergebnis",1
  21.   FF_AddControl "Demo Sortieren","SortListe","EDIT",75,12,65,65
  22.   FF_SetControlStyle "Demo Sortieren","SortListe",2048
  23.   FF_AddControl "Demo Sortieren","Beipieltext laden","BUTTON",17,83,44,9
  24.   FF_AddControl "Demo Sortieren","Sortieren","BUTTON",102,82,33,11
  25.   '** End Dialog Demo Sortieren **
  26.  
  27.   do
  28.      Abbruch = false
  29.      Select Case FF_ShowDialog ("Demo Sortieren")
  30.      Case "CANCEL"
  31.         exit do
  32.      Case "Beipieltext laden"
  33.         FF_SetControl "Demo Sortieren","UrListe", "" & _
  34.            "Ölgemälde" & vbCrLf & "gemeinsam" & vbCrLf & "Äxte" & vbCrLf & "Wehmut" & vbCrLf & "danken" & vbCrLf & _
  35.            "Birnbaum" & vbCrLf & "Übelkeit" & vbCrLf & "zerreißen" & vbCrLf & "tanken" & vbCrLf & "Geruch"
  36.      Case "Sortieren"
  37.         call Vorbereitung
  38.         if not Abbruch then
  39.            call QuickSort(ListenArray,"","")
  40.            call Rekonstruktion
  41.            Ergebnis = join(ListenArray,vbNewLine)
  42.            FF_SetControl "Demo Sortieren","SortListe",Ergebnis
  43.         end if
  44.      End Select
  45.   loop
  46.  
  47.   FF_CloseDialog ("Demo Sortieren")
  48.  
  49.   End Sub
  50.   '------------------------------------------------------------------------
  51.   Sub Vorbereitung
  52.   Dim Text,n,UL,ULn
  53.  
  54.   Text = FF_GetControl ("Demo Sortieren","UrListe")
  55.   if len(Text) = 0 then
  56.      msgbox "Es wurde kein Text eingegeben!",vbInformation,"Hinweis"
  57.      Abbruch = true
  58.      exit sub
  59.   end if
  60.  
  61.   UrListenArray = split(Text,vbNewLine) 'Sicherung des Ursprungs
  62.   ListenArray = split(Text,vbNewLine)
  63.  
  64.   '### Umlautkorrektur für das erste Zeichen
  65.   for n = 0 to UBound(ListenArray)
  66.      UL = left(ListenArray(n),1)
  67.      if instr("ÖÄÜöäü",UL) > 0 then
  68.         select case UL
  69.            case "Ä","ä" : ULn = "Ae"
  70.            case "Ö","ö" : ULn = "Oe"
  71.            case "Ü","ü" : ULn = "Ue"
  72.         case else
  73.         end select
  74.         ListenArray(n) = ULn & mid(ListenArray(n),2) & TZ & UL
  75.      end if
  76.  
  77.      '### String in Großbuchstaben umwandeln
  78.      ListenArray(n) = ucase(ListenArray(n))
  79.   next
  80.  
  81.   End Sub
  82.   '------------------------------------------------------------------------
  83.   Sub Rekonstruktion
  84.   Dim n,pos,element
  85.  
  86.   '### Umlaute wieder zurück setzen
  87.   for n = 0 to UBound(ListenArray)
  88.      pos = instr(ListenArray(n),TZ)
  89.      if pos > 0 then
  90.         ListenArray(n) = right(ListenArray(n),1) & mid(ListenArray(n),3,pos-3)
  91.      end if
  92.  
  93.      '### ursprüngliche Groß- und Kleinschreibung wieder herstellen
  94.      for each element in UrListenArray
  95.         if ListenArray(n) = ucase(element) then ListenArray(n) = element :   exit for
  96.      next
  97.   next
  98.  
  99.   End Sub
  100.   '------------------------------------------------------------------------
  101.   Sub QuickSort(vSort,ByVal lngStart,ByVal lngEnd)
  102.   '### Sortieren des Arrays 'vSort' nach ASCII-Werten
  103.  
  104.   Dim i,j,h,x
  105.  
  106.   if lngStart = "" then lngStart = 0
  107.   if lngEnd = "" then lngEnd = ubound(vSort)
  108.  
  109.   i = lngStart : j = lngEnd
  110.   x = vSort((lngStart + lngEnd) / 2)
  111.  
  112.   '# Array aufteilen
  113.   Do
  114.      While (vSort(i) < x): i = i + 1: Wend
  115.      While (vSort(j) > x): j = j - 1: Wend
  116.  
  117.      If (i <= j) Then
  118.         '# Wertepaare miteinander tauschen
  119.         h = vSort(i)
  120.         vSort(i) = vSort(j)
  121.         vSort(j) = h
  122.         i = i + 1: j = j - 1
  123.      End If
  124.   Loop Until (i > j)
  125.  
  126.   '# Rekursion
  127.   If (lngStart < j) Then call QuickSort(vSort,lngStart,j)
  128.   If (i < lngEnd) Then call QuickSort(vSort,i,lngEnd)
  129.  
  130.   End Sub
  131.   '------------------------------------------------------------------------

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

  1.   Sub QuickSortMultiDim(vSort, index, lngStart, lngEnd)
  2.       ' sortiert ein zweidimensionales Feld nach einem anzugebenden Index (Spalte)
  3.       ' vSort -> zweidimensionales Array
  4.       ' index -> Spalte, nach der sortiert werden soll (1, 2, 3, ...)
  5.        Dim i, j, h, x, u, lb_dim, ub_dim
  6.       ' Wird die Bereichsgrenze mit "" angegeben, wird das gesamte Array sortiert
  7.       if lngStart = "" then lngStart = 0
  8.       if lngEnd = "" then lngEnd = ubound(vSort)
  9.       ' Wird Index mit "" angegeben, wird nach der ersten Spalte sortiert
  10.       if index = "" then index = 1
  11.  
  12.       ' Anzahl Elemente pro Datenzeile
  13.       lb_dim = LBound(vSort, 2)
  14.       ub_dim = UBound(vSort, 2)
  15.  
  16.       i = lngStart
  17.       j = lngEnd
  18.       x = vSort((lngStart + lngEnd) / 2, index - 1)
  19.  
  20.       ' Array aufteilen
  21.       Do
  22.           While (vSort(i, index - 1) < x): i = i + 1: Wend
  23.           While (vSort(j, index - 1) > x): j = j - 1: Wend
  24.  
  25.           If (i <= j) Then
  26.               ' Wertepaare miteinander tauschen
  27.               For u = lb_dim To ub_dim
  28.                   h = vSort(i, u)
  29.                   vSort(i, u) = vSort(j, u)
  30.                   vSort(j, u) = h
  31.               Next
  32.               i = i + 1: j = j - 1
  33.           End If
  34.       Loop Until (i > j)
  35.  
  36.     ' Rekursion (Funktion ruft sich selbst auf)
  37.     If (lngStart < j) Then QuickSortMultiDim vSort, index, lngStart, j
  38.     If (i < lngEnd) Then QuickSortMultiDim vSort, index, i, lngEnd
  39.   End Sub