Für 32Bit und 64Bit Office Versionen
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
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.
