VBA Tipp: Spezial TRIM/LTRIM/RTIM mit ASCII-Abgrenzung

Aus DBWiki
Wechseln zu: Navigation, Suche

Anforderung

In Access gibt es die Funktionen Trim, LTrim und RTrim, um führende und/oder nachgestellte Leerzeichen zu entfernen.

  • Ich möchte aber, wie in anderen Programmiersprachen (z.B. Oracle, MS SQL Server) möglich, zusätzlich zu den Leerzeichen noch weitere nicht darstellbare Steuerzeichen (ASCII-Code 0 bis 32) entfernen.
  • Optional kann ich weitere führende und/oder nachgestellte benutzerdefinierte Zeichen entfernen.

Lösung

Das geht mit den folgenden Funktionen, die in einem globalen Modul hinterlegt werden:

  • TrimE: erweiterte Trim-Funktion
  • LTrimE: erweiterte LTrim-Funktion
  • RTrimE: erweiterte RTrim-Funktion
Public Function TrimE(ByVal Zeichenfolge As String, _
                      Optional ByVal Löschzeichen As String = vbNullString) _
                      As String
 
 'TrimE: erweiterte Trim-Funktion
 
 'Löscht alle führenden und nachgestellten Zeichen:
 '  - kleiner oder gleich ASCII-Code 32
 '    z.B. Leerzeichen (32), Zeilenvorschubzeichen (10), Wagenrücklaufzeichen (13), Tabulator (9), usw.
 '  - die im optionalen Parameter "Löschzeichen" angegeben werden
 
 'Quelle: www.dbwiki.net oder www.dbwiki.de
 
 Dim i As Long
 Dim j As Long
 Dim lPos As Long
 Dim rPos As Long
 Dim gefunden As Boolean
 
 On Error Resume Next
 
 'Führende Zeichen suchen
 For i = 1 To Len(Zeichenfolge)
 
   gefunden = False
   lPos = lPos + 1
 
   If AscW(Mid(Zeichenfolge, i, 1)) > 32 Then
 
     For j = 1 To Len(Löschzeichen)
       If Mid(Zeichenfolge, i, 1) = Mid(Löschzeichen, j, 1) Then
         gefunden = True
       End If
     Next j
 
     If gefunden = False Then
       Exit For
     End If
 
   End If
 
 Next i
 
 'Nachgestellte Zeichen suchen
 For i = Len(Zeichenfolge) To 0 Step -1
 
   gefunden = False
   rPos = rPos + 1
 
   If AscW(Mid(Zeichenfolge, i, 1)) > 32 Then
 
     For j = 1 To Len(Löschzeichen)
       If Mid(Zeichenfolge, i, 1) = Mid(Löschzeichen, j, 1) Then
         gefunden = True
       End If
     Next j
 
     If gefunden = False Then
       rPos = rPos - 1
       Exit For
     End If
 
   End If
 Next i
 
 If lPos = 0 Then
   lPos = 1
 End If
 
 If err.Number <> 0 Then
   err.Clear
   TrimE = ""
 End If
 
 TrimE = Mid(Zeichenfolge, lPos, Len(Zeichenfolge) - lPos + 1 - rPos)
 
End Function
Public Function LTrimE(ByVal Zeichenfolge As String, _
                      Optional ByVal Löschzeichen As String = vbNullString) _
                      As String
 
 'LTrimE: erweiterte LTrim-Funktion
 
 'Löscht alle führenden Zeichen:
 '  - kleiner oder gleich ASCII-Code 32
 '    z.B. Leerzeichen (32), Zeilenvorschubzeichen (10), Wagenrücklaufzeichen (13), Tabulator (9), usw.
 '  - die im optionalen Parameter "Löschzeichen" angegeben werden
 
 'Quelle: www.dbwiki.net oder www.dbwiki.de
 
 Dim i As Long
 Dim j As Long
 Dim lPos As Long
 Dim gefunden As Boolean
 
 On Error Resume Next
 
 'Führende Zeichen suchen
 For i = 1 To Len(Zeichenfolge)
 
   gefunden = False
   lPos = lPos + 1
 
   If AscW(Mid(Zeichenfolge, i, 1)) > 32 Then
 
     For j = 1 To Len(Löschzeichen)
       If Mid(Zeichenfolge, i, 1) = Mid(Löschzeichen, j, 1) Then
         gefunden = True
       End If
     Next j
 
     If gefunden = False Then
       Exit For
     End If
 
   End If
 
 Next i
 
 If lPos = 0 Then
   lPos = 1
 End If
 
 If err.Number <> 0 Then
   err.Clear
   LTrimE = ""
 End If
 
 LTrimE = Mid(Zeichenfolge, lPos)
 
End Function
Public Function RTrimE(ByVal Zeichenfolge As String, _
                      Optional ByVal Löschzeichen As String = vbNullString) _
                      As String
 
 'RTrimE: erweiterte RTrim-Funktion
 
 'Löscht alle nachgestellten Zeichen:
 '  - kleiner oder gleich ASCII-Code 32
 '    z.B. Leerzeichen (32), Zeilenvorschubzeichen (10), Wagenrücklaufzeichen (13), Tabulator (9), usw.
 '  - die im optionalen Parameter "Löschzeichen" angegeben werden
 
 'Quelle: www.dbwiki.net oder www.dbwiki.de
 
 Dim i As Long
 Dim j As Long
 Dim rPos As Long
 Dim gefunden As Boolean
 
 On Error Resume Next
 
 'Nachgestellte Zeichen suchen
 For i = Len(Zeichenfolge) To 0 Step -1
 
   gefunden = False
   rPos = rPos + 1
 
   If AscW(Mid(Zeichenfolge, i, 1)) > 32 Then
 
     For j = 1 To Len(Löschzeichen)
       If Mid(Zeichenfolge, i, 1) = Mid(Löschzeichen, j, 1) Then
         gefunden = True
       End If
     Next j
 
     If gefunden = False Then
       rPos = rPos - 1
       Exit For
     End If
 
   End If
 Next i
 
 If err.Number <> 0 Then
   err.Clear
   RTrimE = ""
 End If
 
 RTrimE = Mid(Zeichenfolge, 1, Len(Zeichenfolge) - rPos)
 
End Function

Aufruf

Ergebnisse im Direktfenster anzeigen

 Dim strtext As String
 
 strtext = "  %test €   %" & Chr(13) & Chr(10)
 
 'Beispiel 1: für TrimE
 strtext = TrimE(strtext)
 Debug.Print strtext             'ergibt "%test €   %"
 strtext = TrimE(strtext, "€%")
 Debug.Print strtext             'ergibt "test"
 
 'Beispiel 2: für LTrimE
 strtext = LTrimE(strtext)
 Debug.Print strtext             'ergibt "%test €   %" & Chr(13) & Chr(10)
 strtext = LTrimE(strtext, "€%")
 Debug.Print strtext             'ergibt "test €   %" & Chr(13) & Chr(10)
 
 'Beispiel 3: für RTrimE
 strtext = RTrimE(strtext)
 Debug.Print strtext             'ergibt "  %test €   %"
 strtext = RTrimE(strtext, "€%")
 Debug.Print strtext             'ergibt "  %test"


Wiki hinweis.png

Hinweis: Die Funktionen sind geeignet, um z.B. Zeilenumbrüche (Zeichen 13 und Zeichen 10) oder Sonderzeichen wie Eurozeichen von rechts zu entfernen.


Weblinks