PureBoard

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.

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


 

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