Zufälliger Artikel

Problemstellung:

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

Login Form

1.png1.png9.png3.png4.png4.png6.png
Heute32
Gestern52
Diese Woche375
Dieser Monat1505
Total1193446

  • IP: 54.159.85.193
  • Browser: Unknown
  • Version:
  • OS: Unknown

Online

1
Online

26. Mai 2018