Code: Alles auswählen
Sortieren von alphanumerischem Text sortiert Excel Zeichen um Zeichen von links nach rechts. Enthält eine Zelle beispielsweise den Text "A100", legt Excel diese Zelle hinter eine Zelle mit dem Eintrag "A1" und vor eine Zelle mit dem Eintrag "A11".
Text und Text mit Zahlen werden nach der folgenden Reihenfolge sortiert:
(Leerzeichen) ! # $ % & ( ) * , . / : ";" ? @ [ \ ] ^ _ ` { | } ~ + < = > 0 1 2 3 4 5 6 7 8 9 A Ä B C D E F G H I J K L M N O Ö P Q R S ß T U Ü V W X Y Z.
Apostroph (') und Bindestrich (-) werden mit einer Ausnahme ignoriert: Wenn zwei Textzeichenfolgen sich mit Ausnahme eines Bindestrichs nicht unterscheiden, wird der Text ohne Bindestrich vorangestellt.Ja, das soll schon so sein, denn ich erstelle in Excel das Wörterbuch und sortiere es dort. Das wäre doof, wenn "ähnlich" hinter "Zirkus" kommt.Kaeru Gaman hat geschrieben: muss denn deine Tabelle optisch sortiert sein?
Code: Alles auswählen
Dim sortiercode(256)
sortierung$= " !"+Chr(34)+"$%&()*,./:;?@[\]^_`{|}~´+<=>§°0123456789"
sortierung$=sortierung$ + "aAáÁäÄbBcCdDeEéÉèÈêÊfFgGhHiIjJkKlmMnNoOöÖpPqQrRsSßtTuUüÜvVwWxXyYzZ"
For i = 1 To Len(sortierung$)
sortiercode(Asc(Mid(sortierung$,i,1))) = i + 32 ; 32 dazu, damit es druckbare Zeichen werden
Next
Eins$ = "ärgern"
Zwei$ = "blau"
Einskonvertiert$="" ;
Zweikonvertiert$=""
For i = 1 To Len(Eins$)
Einskonvertiert$=Einskonvertiert$ + Chr(sortiercode(Asc(Mid(Eins$,i,1))))
Next
For i = 1 To Len(Zwei$)
Zweikonvertiert$=Zweikonvertiert$ + Chr(sortiercode(Asc(Mid(Zwei$,i,1))))
Next
Debug Einskonvertiert$
Debug Zweikonvertiert$
If Einskonvertiert$ < Zweikonvertiert$ : Debug Eins$ + " ist kleiner als " + Zwei$ : EndIf
If Einskonvertiert$ > Zweikonvertiert$ : Debug Eins$ + " ist größer als " + Zwei$ : EndIf
) Suche. Die Prozedur lässt sich später mal verwenden um eine Liste zu sortieren. Code: Alles auswählen
Dim Wort.s(24)
Global Dim sortiercode(256)
Global sortierung$= " !"+Chr(34)+"#$%&()*,./:;?@[\]^_`{|}~´+<=>§°0123456789"
sortierung$=sortierung$ + "aAáÁäÄbBcCdDeEéÉèÈêÊfFgGhHiIjJkKlLmMnNoOöÖpPqQrRsSßtTuUüÜvVwWxXyYzZ'-"
For i = 1 To Len(sortierung$)
sortiercode(Asc(Mid(sortierung$,i,1))) = i + 31 ; 31 dazu, damit es druckbare Zeichen werden
Next
Procedure.s ReplaceStrings(String$, StringsToFind$, StringsToReplace$, Separator$=";")
Protected n.l
For n=1 To CountString(StringsToFind$, Separator$)+1
String$=ReplaceString(String$, StringField(StringsToFind$, n, Separator$), StringField(StringsToReplace$, n, Separator$))
Next
ProcedureReturn String$
EndProcedure
Procedure Excelstringvergleich (string1.s,string2.s) ; wird von Excelvergleich aufgerufen
vergleichsergebnis=0
string1konvertiert$="" ;
string2konvertiert$=""
For scanbuchstabe = 1 To Len(string1.s)
string1konvertiert$=string1konvertiert$ + Chr(sortiercode(Asc(Mid(string1.s,scanbuchstabe,1))))
Next
For scanbuchstabe = 1 To Len(string2.s)
string2konvertiert$=string2konvertiert$ + Chr(sortiercode(Asc(Mid(string2.s,scanbuchstabe,1))))
Next
;Debug string1konvertiert$
;Debug string2konvertiert$
If string1konvertiert$ < string2konvertiert$ : vergleichsergebnis = -1 : EndIf
If string1konvertiert$ > string2konvertiert$ : vergleichsergebnis = 1 : EndIf
ProcedureReturn vergleichsergebnis
EndProcedure
Procedure Excelvergleich (string1.s,string2.s)
string1_ohnebindestrich$ = ReplaceString(string1.s, "-", "")
string2_ohnebindestrich$ = ReplaceString(string2.s, "-", "")
;Debug "1ohnebind: " + string1_ohnebindestrich$
string1_ohnebindestrich_gross_egal$ = LCase(string1_ohnebindestrich$)
string2_ohnebindestrich_gross_egal$ = LCase(string2_ohnebindestrich$)
;Debug "1großegal: " + string1_ohnebindestrich_gross_egal$
string1_ohnebindestrich_gross_egal_umlaute_weg$ = ReplaceStrings(string1_ohnebindestrich_gross_egal$, "á;ä;é;è;ê;ö;ü", "a;a;e;e;e;o;u" )
string2_ohnebindestrich_gross_egal_umlaute_weg$ = ReplaceStrings(string2_ohnebindestrich_gross_egal$, "á;ä;é;è;ê;ö;ü", "a;a;e;e;e;o;u" )
excelvergleichswert = Excelstringvergleich (string1_ohnebindestrich_gross_egal_umlaute_weg$,string2_ohnebindestrich_gross_egal_umlaute_weg$)
;Debug " "
;Debug "Ver1: " + string1_ohnebindestrich_gross_egal_umlaute_weg$
;Debug "Ver2: " + string2_ohnebindestrich_gross_egal_umlaute_weg$
;Debug "Wert: " + Str(excelvergleichswert )
If excelvergleichswert = 0
;Debug "Prüfen Umlaute"
excelvergleichswert = Excelstringvergleich (string1_ohnebindestrich_gross_egal$,string2_ohnebindestrich_gross_egal$)
If excelvergleichswert = 0
;Debug "Prüfen"
excelvergleichswert = Excelstringvergleich (string1_ohnebindestrich$,string2_ohnebindestrich$)
If excelvergleichswert = 0
;Debug "Prüfen"
endergebnis = Excelstringvergleich (string1.s,string2.s)
Else ; fertig
endergebnis = excelvergleichswert
EndIf
Else ; fertig
endergebnis = excelvergleichswert
EndIf
Else
endergebnis = excelvergleichswert
EndIf
ProcedureReturn endergebnis
EndProcedure
;Einlesen
Restore Worte
For zz = 1 To 18
Read Wort.s(zz)
;Debug Wort.s(zz)
Next
;Ausgabe
For zz = 1 To 17
vergleich = Excelvergleich (Wort.s(zz),Wort.s(zz+1))
If vergleich = -1 : vergleich$ = " ist kleiner als " : EndIf
If vergleich = 0 : vergleich$ = " ist gleich " : EndIf
If vergleich = 1 : vergleich$ = " ist größer als " : EndIf
Debug Wort.s(zz) + vergleich$ + Wort.s(zz+1)
Next
End
MessageRequester("Info", "Hallo", #MB_ICONASTERISK)
;MessageRequester("Info", A$, #MB_ICONASTERISK)
DataSection
Worte:
Data.s "haustür","haus-tür","hausTür","haus-Tür","Haustür","Haus-tür","Haus--tür","HausTür","Haus-Tür","HAustür","HAus-Tür","háus-tür","häustür","häusTür","hÄus-tür","HÄus-Tür","Haut", "Häut"
EndDataSection