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"


Weblinks


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.


Der Code wurde in Access 2010 erstellt, ist aber auch in früheren Versionen lauffähig.