VBA Tipp: Umlaute ersetzen

Aus DBWiki
Wechseln zu: Navigation, Suche

Aufgabenstellung

Der erste Teil befasst sich damit, Umlaute ("ä", "ö", "ü", "ß") durch die jeweilige Zeichenfolge ohne diakritische Zeichen (also "ae", "oe", "ue", "ss") zu ersetzen.

Der zweite Teil befasst sich mit dem Problem, welches bei dem Import von ASCII Dateien im OEM-Zeichensatz auftreten kann, dass Umlaute in der falschen ASCII-Repräsentation dargestellt werden. Die Funktionen sind von der Logik und Aufbau her identisch.

Umlaute wandeln

Die folgende Funktion berücksichtigt auch Groß-/Kleinschreibung (wandelt also beispielsweise "Ä" in "Ae" und nicht in "AE", wenn der nächste Buchstabe ein Kleinbuchstabe ist):

Public Function Umlaut(S)
Dim I As Integer, Ch As String * 1, Ch1 As String * 1, _
    IsUpCase As Boolean, Res As String
  If IsNull(S) Then Umlaut = Null: Exit Function
  Res = ""
  For I = 1 To Len(S)
    Ch = Mid(S, I, 1)
    Ch1 = IIf(I < Len(S), Mid(S, I + 1, 1), " ")
    ' Nächstes Zeichen ist kein Kleinbuchstabe:
    IsUpCase = (Asc(Ch1) = Asc(UCase(Ch1)))
    Select Case Asc(Ch)
      Case Asc("Ä"): Res = Res & IIf(IsUpCase, "AE", "Ae")
      Case Asc("Ö"): Res = Res & IIf(IsUpCase, "OE", "Oe")
      Case Asc("Ü"): Res = Res & IIf(IsUpCase, "UE", "Ue")
      Case Asc("ä"): Res = Res & "ae"
      Case Asc("ö"): Res = Res & "oe"
      Case Asc("ü"): Res = Res & "ue"
      Case Asc("ß"): Res = Res & "ss"
      Case Else: Res = Res & Ch
    End Select
  Next I
  Umlaut = Res
End Function

Aufruf

Debug.Print Umlaut("Ärger")
Aerger

Oder z.B. in einer Auswahlabfrage mit folgender SQL:

SELECT Umlaut(Nachname) AS NachnameOhneUmlaute FROM MeineTabelle

Oder in einer Aktualisierungsabfrage mit folgender SQL:

UPDATE MeineTabelle SET Nachname = Umlaut(Nachname)


OEM Zeichensatz wandeln

Public Function Umlaut2(S)
Dim i As Integer, Ch As String * 1, Ch1 As String * 1, _
    Res As String
  If IsNull(S) Then Umlaut2 = Null: Exit Function
  Res = ""
 
  For i = 1 To Len(S)
    Ch = Mid(S, i, 1)
    Select Case Asc(Ch)
      Case 142: Res = Res & "Ä"
      Case 153: Res = Res & "Ö"
      Case 154: Res = Res & "Ü"
      Case 132: Res = Res & "ä"
      Case 148: Res = Res & "ö"
      Case 129: Res = Res & "ü"
      Case 225: Res = Res & "ß"
      Case Else: Res = Res & Ch
    End Select
  Next i
  Umlaut2 = Res
End Function

Aufruf

Zum Beispiel beim Textimport (zeilenweise):

Open Pfad For Input As #1
    While Not EOF(1)
        Line Input #1, Tmp
        RS.AddNew
        RS![Text] = Umlaut2(Tmp)
        RS.Update
     Wend
Close #1
Wiki hinweis.png Anmerkung: Die Stringvariable kann bei zu großen Dateien überlaufen, aus diesem Grund bezieht sich dieses Beispiel auf das zeilenweise Einlesen.


Anstelle der Funktion "Umlaut2" kann auch die Systemfunktion OEMToChar verwendet werden, die den Vorteil hat, auch andere Sonderzeichen neben den reinen Umlauten korrekt zu konvertieren:

Private Declare Function OemToChar Lib "user32" Alias "OemToCharA" _
   (ByVal lpszSrc As String, ByVal lpszDst As String) As Long
 
Public Function OEMToAnsiStr(S)
Dim RetVal As Long, Res As String
  If IsNull(S) Then
    OEMToAnsiStr = Null
  Else
    Res = String(Len(S) + 1, 0)
    RetVal = OemToChar(S, Res)
    OEMToAnsiStr = Mid$(Res, 1, Len(S))
  End If
End Function