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 möglich, zusätzlich zu den Leerzeichen

  • noch weitere nicht darstellbare Zeichen (kleiner oder gleich ASCII-Code 32)
  • und ggf. zusätzliche benutzerdefinierte Zeichen (optional)

entfernen.

Lösung

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

  • eTrim: erweiterte Trim-Funktion
  • eLTrim: erweiterte LTrim-Funktion
  • eRTrim: erweiterte RTrim-Funktion
Public Function eTrim(ByVal Zeichenfolge As String, _
                      Optional ByVal Löschzeichen As String = vbNullString) _
                      As String
 
 'eTrim: 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: http://www.dbwiki.net/
 
 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
   eTrim = ""
 End If
 
 eTrim = Mid(Zeichenfolge, lPos, Len(Zeichenfolge) - lPos + 1 - rPos)
 
End Function
Public Function eLTrim(ByVal Zeichenfolge As String, _
                      Optional ByVal Löschzeichen As String = vbNullString) _
                      As String
 
 'eLTrim: 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: http://www.dbwiki.net/
 
 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
   eLTrim = ""
 End If
 
 eLTrim = Mid(Zeichenfolge, lPos)
 
End Function
Public Function eRTrim(ByVal Zeichenfolge As String, _
                      Optional ByVal Löschzeichen As String = vbNullString) _
                      As String
 
 'eRTrim: 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: http://www.dbwiki.net/
 
 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
   eRTrim = ""
 End If
 
 eRTrim = Mid(Zeichenfolge, 1, Len(Zeichenfolge) - rPos)
 
End Function

Aufruf

 Dim strtext As String
 
 strtext = "  %test €   %" & Chr(13) & Chr(10)
 
 'Beispiele für eTrim
 strtext = eTrim(strtext)        'ergibt "%test €   %"
 strtext = eTrim(strtext, "€%")  'ergibt "test"
 
 'Beispiele für eLTrim
 strtext = eLTrim(strtext)       'ergibt "%test €   %" & Chr(13) & Chr(10)
 strtext = eLTrim(strtext, "€%") 'ergibt "test €   %" & Chr(13) & Chr(10)
 
 'Beispiele für eRTrim
 strtext = eRTrim(strtext)       'ergibt "  %test €   %"
 strtext = eRTrim(strtext, "€%") 'ergibt "  %test"
 
 MsgBox strtext


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.