Microsoft Excel

Herbers Excel/VBA-Archiv

Sort mit Umlauten

    Betrifft: Sort mit Umlauten von: franz
    Geschrieben am: 26.08.2003 08:46:36

    Guten Morgen Forum !

    Nach dem Urlaub geht es gleich mit einem Problem
    weiter, wie folgt:

    In einer Spalte A stehen Orte. Diese sollen alphabetisch
    sortiert werden. Nun sollen aber vorher alle Umlaute
    Ü, ü, Ö, ö, Ä, ä, ß in Ue, ue, Oe, oe, Ae, ae und ss
    umgesetzten werden.
    Nach der Umsetzung optisch dargestellt werden, z.B. links das
    Orginal (incl. Umlautenumsetzung - ohne Sort) und in Spalte B
    gleicher Inhalt von Spalte A - aber mit Sort.

    Hintergrund ist folgender:
    Es soll geprüft werden, ob die alphabetische Sortierung der Spalte A
    in Ordnung ist.

    Gruss
    franz

      


    Betrifft: AW: Sort mit Umlauten von: WernerB.
    Geschrieben am: 26.08.2003 09:40:31

    Hallo Franz,

    wie gefällt Dir das?
    Sub Umlaute()
    Dim laR As Long
        Application.ScreenUpdating = False
        laR = Cells(Rows.Count, 1).End(xlUp).Row
        Range("A1:A" & laR).Replace What:="Ä", Replacement:="Ae", _
          LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True
        Range("A1:A" & laR).Replace What:="Ö", Replacement:="Oe", _
          LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True
        Range("A1:A" & laR).Replace What:="Ü", Replacement:="Ue", _
          LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True
        Range("A1:A" & laR).Replace What:="ä", Replacement:="ae", _
          LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True
        Range("A1:A" & laR).Replace What:="ö", Replacement:="oe", _
          LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True
        Range("A1:A" & laR).Replace What:="ü", Replacement:="ue", _
          LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True
        Range("A1:A" & laR).Replace What:="ß", Replacement:="ss", _
          LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True
        Range("A1:A" & laR).Copy
        Range("B1").PasteSpecial Paste:=xlValues, Operation:=xlNone, _
          SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False
        Range("B1:B" & laR).Sort Key1:=Range("B1"), Order1:=xlAscending, Header:=xlNo, _
          OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
        Application.ScreenUpdating = True
    End Sub
    

    Viel Erfolg wünscht
    WernerB.

    P.S.: Das Forum lebt auch von den Rückmeldungen der Fragesteller. Danke!


      


    Betrifft: AW: Sort mit Umlauten von: franz
    Geschrieben am: 26.08.2003 10:33:19

    Hallo Werner !

    Danke für Deine Antwort.
    Werde versuchen noch vor Mittag zu testen.

    Werde natürlich Erfolg oder Nichterfolg schreiben.

    Gruss Franz


      


    Betrifft: AW: Sort mit Umlauten von: franz
    Geschrieben am: 26.08.2003 13:26:55

    Hallo Werner !

    So, jetzt habe ich es getestet und es funktioniert
    wunderbar!!!! toll..


    Kann ich auch die Unterschiede in Spalte C rausschreiben lassen ?



    Gruss
    Franz


      


    Betrifft: AW: Sort mit Umlauten von: WernerB.
    Geschrieben am: 26.08.2003 13:30:17

    Hallo Franz,

    was verstehst Du unter "Unterschiede" (Beispiel)?


    Gruß WernerB.


      


    Betrifft: AW: Sort mit Umlauten von: franz
    Geschrieben am: 26.08.2003 15:53:44

    Hallo !

    Ich meinte, kann man in der Spalte C einen Vermerk reinschreiben
    lassen, wie z.B.: hier in Zeile xx Sort nicht in Ordnung, o.ä.
    Soll heißen, daß ich gleich sehe, wo der Sort nicht in Ordnung ist.


    Gruss
    franz


      


    Betrifft: AW: Sort mit Umlauten von: WernerB.
    Geschrieben am: 27.08.2003 10:59:33

    Hallo Franz,

    dazu biete ich Dir folgende Lösung an:
    Sub Umlaute()
    Dim laR As Long
        Application.ScreenUpdating = False
        laR = Cells(Rows.Count, 1).End(xlUp).Row
        Range("A1:A" & laR).Replace What:="Ä", Replacement:="Ae", _
          LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True
        Range("A1:A" & laR).Replace What:="Ö", Replacement:="Oe", _
          LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True
        Range("A1:A" & laR).Replace What:="Ü", Replacement:="Ue", _
          LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True
        Range("A1:A" & laR).Replace What:="ä", Replacement:="ae", _
          LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True
        Range("A1:A" & laR).Replace What:="ö", Replacement:="oe", _
          LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True
        Range("A1:A" & laR).Replace What:="ü", Replacement:="ue", _
          LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True
        Range("A1:A" & laR).Replace What:="ß", Replacement:="ss", _
          LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True
        Range("A1:A" & laR).Copy
        Range("B1").PasteSpecial Paste:=xlValues, Operation:=xlNone, _
          SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False
        Range("B1:B" & laR).Sort Key1:=Range("B1"), Order1:=xlAscending, Header:=xlNo, _
          OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
        With Range("C1:C" & laR)
          .ClearContents
          .Font.ColorIndex = 3
          .Font.Bold = True
          .Font.Italic = True
        End With
        Range("C1").Formula = _
            "=IF(A1=B1,"""",""Keine Übereinstimmung in Zeile ""&ROW()&"" !"")"
        Range("C1").AutoFill Destination:=Range("C1:C" & laR), Type:=xlFillDefault
        Application.ScreenUpdating = True
    End Sub
    

    Gruß WernerB.


      


    Betrifft: AW: Sort mit Umlauten von: franz
    Geschrieben am: 27.08.2003 11:20:21

    Guten Tag Werner !

    Hab es doch gleich mal ausprobiert.

    Es hat geklappt.
    Ein dickes Lob an Dich.. hatte gestern abend noch
    ohne Erfolg probiert.

    Merci auch an alle Mitwirkenden im Forum !!


    franz