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)
Dim sTest As String Dim vResult As Variant sTest = "Heinz , Herbert , Bruno , Fritz , Konrad" vResult = GetArg_Split(sTest, ",", 2)
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
Dim sTest As String Dim vResult As Variant sTest = "Heinz , Herbert ; Bruno & Fritz / Konrad" vResult = SplitEx(sTest, "-&/,;", -1)
Dim sTest As String Dim vResult As Variant sTest = "Heinz , Herbert ; Bruno & Fritz / Konrad" vResult = SplitEx(sTest, "-&/,;", 2)
Ähnliche Artikel
Weiterlesen...