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(Anything As Variant) As Variant
   Dim i        As Long
   Dim Ch       As String * 1
   Dim Ch1      As String * 1
   Dim Res      As String
   Dim IsUpCase As Boolean
 
   If IsNull(Anything) Then Umlaut = Null: Exit Function
 
   For i = 1 To Len(Anything)
      Ch = Mid$(Anything, i, 1)
      Ch1 = IIf(i < Len(Anything), Mid$(Anything, i + 1, 1), " ")
      ' Nächstes Zeichen ist kein Kleinbuchstabe:
      IsUpCase = CBool((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
   Umlaut = Res
End Function

Aufruf

   Debug.Print Umlaut("Ärger")
   '=> Aerger

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

SELECT Umlaut(Nachname) AS NachnameOhneUmlaute FROM MeineTabelle

Oder in einer Aktualisierungsabfrage mit folgender SQL-Anweisung:

UPDATE MeineTabelle SET Nachname = Umlaut(Nachname)

OEM Zeichensatz wandeln

Public Function Umlaut2(Anything)
   Dim i   As Integer
   Dim Ch  As String * 1
   Dim Ch1 As String * 1
   Dim Res As String
 
   If IsNull(Anything) Then Umlaut2 = Null: Exit Function
 
   For i = 1 To Len(Anything)
      Ch = Mid$(Anything, 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
   Umlaut2 = Res
End Function

Aufruf

Zum Beispiel beim Textimport (zeilenweise):

   Open Pfad For Input As #1
   Do Until EOF(1)
      Line Input #1, Tmp
      rs.AddNew
      rs!Text = Umlaut2(Tmp)
      rs.Update
   Loop
   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 API-Funktion OEMToChar verwendet werden, die den Vorteil hat, auch andere Sonderzeichen neben den reinen Umlauten korrekt zu konvertieren:

Private Declare Function OemToCharA Lib "user32" ( _
   ByVal lpszSrc As String, _
   ByVal lpszDst As String) As Long
 
Public Function OEMToAnsiString(Anything As Variant) As Variant
   Dim retVal As Long
   Dim buf As String
 
   If IsNull(Anything) Then
      OEMToAnsiString = Null
   Else
      buf = String$(Len(Anything) + 1, vbNullChar)
      retVal = OemToCharA(Anything, buf)
      If retVal Then
         OEMToAnsiString = Mid$(buf, 1, Len(Anything))
      Else
         OEMToAnsiString = Null
      End If
   End If
End Function