Kontakt
DSVGO
Dim s As String Dim v As Variant s = "Willi Wacker und sein Dackel" v = Split(s) MsgBox UBound(v) 'ergibt "4" MsgBox v(1) 'ergibt "Wacker"
Public Function Split( _ ByRef Expression As String, _ Optional ByRef Delimiter As String = " ", _ Optional ByVal Count As Long = -1, _ Optional ByVal Compare As VbCompareMethod = vbBinaryCompare _ ) As Variant Dim DelimiterLen As Long Dim Index As Long Dim Start As Long Dim Strings() As String Dim StringsCount As Long Dim StringsUBound As Long Dim StringsPtr As Long If Count And Len(Expression) > 0 Then DelimiterLen = Len(Delimiter) If DelimiterLen Then 'Speicher reservieren: If Count < 0 Then Count = Len(Expression) \ DelimiterLen Else Count = Count - 1 End If If Count < 2048 Then StringsUBound = Count Else StringsUBound = 1024 End If ReDim Strings(StringsUBound) 'String splitten: Start = 1 For StringsCount = 0 To Count - 1 'Nächsten Delimiter suchen: Index = InStr(Start, Expression, Delimiter, Compare) If Index = 0 Then Exit For 'Ggf. Array vergrößern: If StringsCount > StringsUBound Then StringsUBound = StringsCount * 2 ReDim Preserve Strings(StringsUBound) End If 'Teilstring speichern: Strings(StringsCount) = _ Mid$(Expression, Start, Index - Start) Start = Index + DelimiterLen Next StringsCount Strings(StringsCount) = Mid$(Expression, Start) 'Ggf. Array verkleinern: If StringsCount < StringsUBound Then _ ReDim Preserve Strings(StringsCount) Else 'Delimiter ist Leerstring: ReDim Strings(0) Strings(0) = Expression End If 'DelimiterLen Split = Strings Else 'Nichts zu tun: Split = Array() End If 'Count And Len(Expression) > 0 End Function
© Jost Schwider, 20.01.2001-20.01.2001 - http://vb-tec.de/strsplit.htm