meta data for this page
  •  

Unterschiede

Hier werden die Unterschiede zwischen zwei Versionen gezeigt.

Link zu der Vergleichsansicht

sortieren-von-texten [2013/02/24 15:17] (aktuell)
Zeile 1: Zeile 1:
 +====== 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.\\ \\ \\ {{/​file/​view/​Sortieren.gif/​356399406/​Sortieren.gif|Sortieren.gif}}
 +==== Sortieren (vbs) ====
 +  '​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
 +  '​------------------------------------------------------------------------
 +
 +   
 +\\ 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) ====
 +  '​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
 +  '​------------------------------------------------------------------------
 +
 +   
 +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 ======
 +  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
 +\\ \\ \\ Sortieren+ (vbs)