Tabellenkalkulation: baltische Zeichen mit VBA-Makro in deutsches Alphabet umwandeln

baltische Zeichen mit VBA-Makro in deutsches Alphabet umwandeln

(383 Hits)

Hallo,
ich kopiere regelmaessig aus Webseiten Aufstellungen von Fußballspielen in eine Excel-Datei (Excel 2010). Die dann dort aufbereiteten Daten moechte ich in einer anderen Webseite weiterverarbeiten. Nun gibt es hier aber eine Menge Spieler, die aus dem früheren Ostblock-Staaten, Skandinavien oder Westeuropa kommen. Und die haben im Namen jede Menge Sonderzeichen wie "á“, „č“, „ş“ und viele mehr. Auf meiner Webseite erscheinen diese Zeichen jedoch als Fragezeichen.
Ich möchte deshalb diese Zeichen mit einem Makro in das deutsche Alphabet (a, c, s, usw). Aber mein Makro, dass sonst in einfachen Fällen hilft, funktioniert hier nicht.

Selection.Replace What:="+á", Replacement:="a", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False

Entweder werden beim Durchlauf die Zeichen wie „á“ ignoriert und nicht umgewandelt. Oder ich kann die Buchstaben (bei obigen Beispiel „č“ und „ş“) lassen sich überhaupt nicht in den Editor schreiben, sondern werden auch hier nur als Fragezeichen abgebildet.
Was mache ich verkehrt?

Hallo Community .-)

Folgende Lösung hab ich erstellt

Gruß Nighty

In eine Leere Mappe das Makro einfügen

Spalte A ab Zeile 2 die Sonderzeichen verschiedener Länder
Spalte B ab Zeile 2 die zu ersetzenden Zeichen

Makro starten
Datei mit doppelclick auswählen
Betreff alle Worksheets der Mappe!
Es werde alle Steuerzeichen gelöscht
Dann die Liste mit den Sonderzeichen abgearbeitet und die Zeichen ersetzt
Datei wird gespeichert
Fertig

Sub DeleteReplace()
    Call EventsOff
    Dim rngZelle As Range
    Dim strZeichen As String
    Dim WksIndex As Integer
    Dim lngI As Long, ArrIndex As Long
    Dim Sliste As Variant, GetMappe As Variant, a As Validation
    Dim booZelleMitSteuerzeichen As Boolean
    Sliste = Range("A2:B" & ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row)
    GetMappe = Application.GetOpenFilename("Xls Files (*.xls), *.xls")
    Workbooks.Open Filename:="" & GetMappe
    For WksIndex = 1 To Worksheets.Count
        Worksheets(WksIndex).Activate
        For Each rngZelle In Worksheets(WksIndex).UsedRange.Cells
            For lngI = 1 To Len(rngZelle.Value)
                strZeichen = Mid(rngZelle.Value, lngI, 1)
                Select Case Asc(strZeichen)
                Case 1 To 31, 127, 129, 141, 143, 144, 157
                    If Not (rngZelle.HasFormula) Then
                        rngZelle.Value = Application.WorksheetFunction.Replace(rngZelle.Value, lngI, 1, Chr(9))
                        booZelleMitSteuerzeichen = True
                    End If
                Case 160
                    If Not (rngZelle.HasFormula) Then
                        rngZelle.Value = Application.WorksheetFunction.Replace(rngZelle.Value, lngI, 1, Chr(32))
                    End If
                End Select
            Next lngI
            If booZelleMitSteuerzeichen And Not (rngZelle.HasFormula) Then
                rngZelle.Value = Application.WorksheetFunction.Clean(rngZelle.Value)
                booZelleMitSteuerzeichen = False
            End If
        Next rngZelle
        For ArrIndex = LBound(Sliste) To UBound(Sliste)
            Cells.Replace What:=Sliste(ArrIndex, 1), Replacement:=Sliste(ArrIndex, 2), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
        Next ArrIndex
    Next WksIndex
    Workbooks(Mid(GetMappe, InStrRev(GetMappe, "\") + 1, Len(GetMappe))).Close SaveChanges:=True
    Call EventsOn
End Sub

Public Sub EventsOff()
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With
End Sub

Public Sub EventsOn()
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
    End With
End Sub