1 1 1 1 1 1 1 1 1 1 Rating 0.00 (0 Votes)

Problemstellung:

Für 32Bit und 64Bit Office Versionen

Immer wieder stellt sich die Frage wie kann ich einen Text aufsplitten weil man
daraus nur einem bestimmten Teilstring braucht.
Hinzu kommt meist noch das Problem das die Teilstrings nicht durch das
gleiche Trennungszeichen (Delimeter) getrennt sind.
Ich stelle hier ein paar Lösungen zu diesem Thema vor.

1. Diese Funktion gibt gegenüber der Split-Function nicht nur
einzelne Argumente zurück sondern auch die Anzahl der Argumente.

Public Function GetArg(vText As Variant, sDelimeter As String, _
                       iPos As Integer) As Variant
'*******************************************
'Name:      GetArg (Funktion)
'Purpose:   Strings splitten
'Date:      April 04, 2018, 12:00
'Inputs:    vText= Der String der gesplittert werden soll
'           sDelimeter= Trennzeichen
'           iPos= Angabe des Arguments im String das gelesen werden soll
'                 0 gibt die Anzahl der Argumente im String zurück
'Output:    Anzahl der Argumente oder String von bestimmer Position
'*******************************************
On Error GoTo ErrHandler

Dim Pos As Integer
 
    If IsNull(vText) And iPos = 0 Then GetArg = 0: Exit Function
    If IsNull(vText) And iPos > 0 Then GetArg = Null: Exit Function
 
    If Right$(vText, Len(sDelimeter)) <> sDelimeter Then
        vText = vText & sDelimeter
    End If
 
    If Left(vText, Len(sDelimeter)) <> sDelimeter Then
        vText = sDelimeter & vText
    End If
 
    If iPos = 0 Then
        Dim Anzahl As Integer
        Anzahl = 0
        Pos = InStr(1, vText, sDelimeter)
        While Pos <> 0
            Anzahl = Anzahl + 1
            Pos = InStr(Pos + 1, vText, sDelimeter)
        Wend
        GetArg = Anzahl - 1
    Else
        Dim i As Integer
        Dim EndPos As Integer
        Pos = 0
        For i = 1 To iPos
 
            Pos = InStr(Pos + 1, vText, sDelimeter)
            If Pos = 0 Then GetArg = Null: Exit Function
        Next i
        EndPos = InStr(Pos + 1, vText, sDelimeter)
        If EndPos = 0 Then GetArg = Null: Exit Function
        GetArg = Trim(Mid(vText, Pos + Len(sDelimeter), EndPos - Pos - Len(sDelimeter)))
    End If

ExitHere:
    Exit Function
ErrHandler:
    Dim strErrString As String
    strErrString = "Error Information..." & vbCrLf
    strErrString = strErrString & "Error#: " & Err.Number & vbCrLf
    strErrString = strErrString & "Description: " & Err.Description
    MsgBox strErrString, vbCritical + vbOKOnly, "Function: GetArg"
    Resume ExitHere
End Function

 z.B.

Dim sTest As String
Dim vResult As Variant

    sTest = "Heinz , Herbert , Bruno , Fritz , Konrad"
    vResult = GetArg(sTest, ",", 0)

In diesem Fall würde vResult = 5 sein, da es 5 Argumente (Namen) sind.

Dim sTest As String
Dim vResult As Variant

    sTest = "Heinz , Herbert , Bruno , Fritz , Konrad"
    vResult = GetArg(sTest, ",", 2)

Und hier wäre vResult = "Herbert" da der letzte Parameter = 2 ist. Somit wird das 2. Argument zurück gegeben.

 2. Function unter Verwendung der Split-Function

Public Function GetArg_Split(sText As String, _
                             sDelimeter As String, _
                             Optional iPos As Integer = -1) As Variant
'*******************************************
'Name:      GetArg_Split (Funktion)
'Purpose:   Strings splitten
'Author:    Thomas Keßler
'Date:      April 04, 2018, 12:00
'Inputs:    sText= Der String der gesplittert werden soll
'           sDelimeter= Trennzeichen
'           iPos= Angabe der Postion im String die gelesen werden soll
'                 -1 gibt die Anzahl der vorhandenen Trennzeichen im String zurück
'Output:    Anzahl der Trennzeichen oder String von bestimmer Position
'*******************************************
On Error GoTo ErrHandler

    Dim sArray() As String

    sArray = Split(sText, sDelimeter)
    If iPos = -1 Then
        GetArg_Split = UBound(sArray)
    Else
        GetArg_Split = Trim(sArray(iPos))
    End If

ExitHere:
    Exit Function
ErrHandler:
    Dim strErrString As String
    strErrString = "Error Information..." & vbCrLf
    strErrString = strErrString & "Error#: " & Err.Number & vbCrLf
    strErrString = strErrString & "Description: " & Err.Description
    MsgBox strErrString, vbCritical + vbOKOnly, "Function: GetArg_Split"
    Resume ExitHere
End Function

Anders als in der ersten Function gibt diese Function bei der Übergabe iPos = -1 nicht die Anzahl der Argumente sondern die Anzahl der Trennzeichen zurück.

z.B.

Dim sTest As String
Dim vResult As Variant

    sTest = "Heinz , Herbert , Bruno , Fritz , Konrad"
    vResult = GetArg_Split(sTest, ",", -1)
 
In diesem Fall würde vResult = 4 sein, da es 4 Trennzeichen (Kommas) sind.
 
Dim sTest As String
Dim vResult As Variant

    sTest = "Heinz , Herbert , Bruno , Fritz , Konrad"
    vResult = GetArg_Split(sTest, ",", 2)
 
Und hier wäre vResult = "Bruno" deshalb weil die Split-Function beim Auftrennen der Argumente beim Index 0 anfängt.
 
3. erweiterte Function unter Verwendung der Split-Function 
 
Diese Function stammt aus dem DBWiki und wurde von mir etwas verändert.
Anders als in der oberen Version ist es hier möglich Strings zu übergeben die durch mehrere unterschiedliche Trennzeichen getrennt sind.
 
Public Function SplitEx(vText As Variant, sDelimeter As String, _
                        Optional iPos As Integer = -1, _
                        Optional EmptyString As Boolean = False) As Variant
'*******************************************
'Name:      SplitEx (Funktion)
'Purpose:   Strings splitten, auch mit mehreren Trennzeichen
'Author:    DBWiki, angepasst Thomas Keßler
'Date:      April 04, 2018, 12:00
'Inputs:    vText= Der String der gesplittert werden soll
'           sDelimeter= ein oder mehrere Trennzeichen
'           iPos= Angabe der Postion im String die gelesen werden soll
'                 -1 gibt die Anzahl der vorhandenen Trennzeichen im String zurück
'           EmptyString= Rückgabe leere Zeichenfolgen (Null-Strings) True oder False
'Output:    Anzahl der Trennzeichen oder String von bestimmer Position
'*******************************************
On Error GoTo ErrHandler

    Dim i As Long
    Dim sF_Delimeter As String
    Dim sArray() As String
 
    sF_Delimeter = Left$(sDelimeter, 1)
 
   'sDelimeter 2-n mit 1. sDelimeter ersetzen
    For i = 2 To Len(sDelimeter)
        vText = Replace(vText, Mid$(sDelimeter, i, 1), sF_Delimeter)
    Next
    If EmptyString = False Then
        Do While InStr(1, vText, sF_Delimeter & sF_Delimeter) > 0
            vText = Replace(vText, sF_Delimeter & sF_Delimeter, sF_Delimeter)
        Loop
    End If
    sArray = Split(vText, sF_Delimeter)
    If iPos = -1 Then
        SplitEx = UBound(sArray)
    Else
        SplitEx = Trim(sArray(iPos))
    End If
    
ExitHere:
    Exit Function
ErrHandler:
    Dim strErrString As String
    strErrString = "Error Information..." & vbCrLf
    strErrString = strErrString & "Error#: " & Err.Number & vbCrLf
    strErrString = strErrString & "Description: " & Err.Description
    MsgBox strErrString, vbCritical + vbOKOnly, "Function: SplitEx"
    Resume ExitHere
End Function
 
 z.B.
 
Dim sTest As String
Dim vResult As Variant

    sTest = "Heinz , Herbert ; Bruno & Fritz / Konrad"
    vResult = SplitEx(sTest, "-&/,;", -1)
 
In diesem Fall würde vResult = 4 sein, da es 4 Trennzeichen (, ; & /) sind.
 
Dim sTest As String
Dim vResult As Variant

    sTest = "Heinz , Herbert ; Bruno & Fritz / Konrad"
    vResult = SplitEx(sTest, "-&/,;", 2)
 
Und auch hier wäre vResult = "Bruno" deshalb weil die Split-Function beim Auftrennen der Argumente beim Index 0 anfängt. 
 

 

Ähnliche Artikel

You have no rights to post comments

Login Form

Neueste Artikel

SQL zu VBA Konverter
26. Oktober 2018
Problemstellung: Nur für 32Bit Office Versionen Gibt es eine Möglichkeit SQL-Code einer Abfrage so zu konvertieren das der Code in VBA genutzt werden kann? Lösung: Bis Access 2010 gibt das Tool...
1.png5.png7.png9.png0.png6.png7.png
Heute99
Gestern486
Diese Woche1416
Dieser Monat7690
Total1579067

  • IP: 54.234.6.167
  • Browser: Unknown
  • Version:
  • OS: Unknown

Online

1
Online

29. März 2024

Letzte Kommentare

  • Berechnen von Zeiträumen als Abfragekriterium

    elmard 02.02.2021 21:02
    1000 Dank
    für diese Datenbankanwendung! Eine sehr gute Umsetzung mit den vielen Möglichkeiten des Datums.

    Weiterlesen...

     
  • SQL zu VBA Konverter

    Tommy Admin 03.11.2019 16:33
    RE: SQL zu VBA Konverter
    Hallo Elmard, danke für die Info. :lol:

    Weiterlesen...

     
  • SQL zu VBA Konverter

    elmard 03.11.2019 14:49
    Bei SmartTools neue Version 4.0
    Dieses Tool liegt inzwischen in der Version 4 vor und läuft nun auch von A2013 und A2016 sowie im ...

    Weiterlesen...

     
  • Workshop zur Benutzung des Multi-Column TreeView Control unter MS-Access

    TommyK 27.02.2019 06:52
    Workshop
    Hallo mpegjunkie, danke für Dein Feedback. Schön das Dir Workshop weiter hilft. :D

    Weiterlesen...

     
  • Workshop zur Benutzung des Multi-Column TreeView Control unter MS-Access

    mpegjunkie 26.02.2019 20:10
    Perfekter Workshop
    Hallo Tommy, perfekter Workshop, toll und umfassend erläutert. Jetzt nutze ich diese Controls auch.

    Weiterlesen...