User Tools

Site Tools


vba:functions:trims

[VBA] trims()

trims() ist eine Trim-Funktion für Strings. Im Gegensatz zu trim() entfernt trims() auch NewLines und Tabulatoren. Zudem kann auch ein RTrim oder LTrim ausgeführt werden

Version 1.1.1 - 11.07.2018

Definition

Public Function trims( _
        ByVal iString As String, _
        Optional ByVal iDirection As trDirection = trBoth _
) As String

Beispiele

Für die Ausgabe der Resultate verwendete ich die Funktion [VBA] print_r()
'Ein normaler VBA.trim() entfernt nur Leerzeichen
print_r trim("  Der Hund " & vbtab & vbcrlf & "   ")
<String> 'Der Hund \t\r\n'
 
'tims() entfernt alle White-Space Characters. New Line, Tabulatoren, Leerzeichen etc. (RegExp-Pattern '\s')
print_r trims("  Der Hund " & vbtab & vbcrlf & "   ")
<String> 'Der Hund'
 
'Oder nur links trimmen
print_r trims("  Der Hund " & vbtab & vbcrlf & "   ", trLeft)
<String> 'Der Hund \t\r\n   '
 
'und nur rechts
print_r trims("  Der Hund " & vbtab & vbcrlf & "   ", trRight)
<String> '  Der Hund'

Code

udf_trims.bas
Attribute VB_Name = "udf_trims"
'-------------------------------------------------------------------------------
'File         : udf_trims.bas
'               Copyright mpl by ERB software
'               All rights reserved
'               http://wiki.yaslaw.info/dokuwiki/doku.php/vba/
'Environment  : VBA 2007 +
'Version      : 1.1.1
'Name         : trims
'Author       : Stefan Erb (ERS)
'History      : 22.07.2014 - ERS - Creation
'               31.10.2014 - ERS - Cache durch Static ersetzt
'               04.11.2014 - ERS - \u0000 als Whitespace hinzugefügt
'               11.07.2018 - ERS - Pattern angepasst, damit aein String de nur aus Leerzeicen besteht auf ein Leerstring getrimmt wird
'-------------------------------------------------------------------------------
Option Explicit
 
' Entfernt alle Spaces vor und nach dem Text mittels RegExp.
' Das s am Ende des Namens steht dann auch für \s. Also alle Spaces
' Die RegExp werden während ded ganzen Session gehalten um. Das beschleunigt die Funktion beim EInsatz in SQL
 
Public Enum trDirection
    [_FIRST] = 1
    trLeft = [_FIRST]   'LTRIM()
    trRight = 2         'RTRIM()
    trBoth = 3          'TRIM() (trLeft + trRight)
    [_LAST] = trBoth
End Enum
 
Private Const C_PATTERN = "^[\s\u0000]*([\S\s]*\b)?[\s\u0000]*$"
Private Const C_L_PATTERN = "^[\s\u0000]*([\S\s\u0000]*)?$"
Private Const C_R_PATTERN = "^([\S\s\u0000]*\b)?[\s\u0000]*$"
 
'/**
' * trim \s:    Entfernt im Gegensatz zu trim() auch Zeilenumbrüche, Tabulatoren etc. Alles was regexp \s ist
' *
' *     string = trims(string [,direction][,clearCache])
' *
' * @param  String
' * @param  trDirection     Angabe, auf welcher Seite getrimmt werden soll
' * @return String
' */
Public Function trimS( _
        ByVal iString As String, _
        Optional ByVal iDirection As trDirection = trBoth _
) As String
    trimS = rxTrim(iDirection).replace(iString, "$1")
End Function
 
Public Function rTrimS(ByVal iString As String) As String
    rTrimS = rxTrim(trRight).replace(iString, "$1")
End Function
 
Private Property Get rxTrim(Optional ByVal iDirection As trDirection = trBoth) As Object
    Static cacheRxTrim(trDirection.[_FIRST] To trDirection.[_LAST]) As Object
    If cacheRxTrim(iDirection) Is Nothing Then
        Set cacheRxTrim(iDirection) = CreateObject("VBScript.RegExp")
        cacheRxTrim(iDirection).pattern = Choose(iDirection, C_L_PATTERN, C_R_PATTERN, C_PATTERN)
    End If
    Set rxTrim = cacheRxTrim(iDirection)
End Property
 
 
vba/functions/trims.txt · Last modified: 11.07.2018 11:39:16 by yaslaw