How to split a string with multiple delimiters in vba excel?

后端 未结 6 892
终归单人心
终归单人心 2021-01-01 14:53

I want to split a string with multiple delimiters using Excel VBA. One of the strings is:

d1-d2 d3 d4  

We have a dash and a space as tw

6条回答
  •  温柔的废话
    2021-01-01 15:16

    I'll add that I had a quick look at Chip Pearson's answer, and thought it could be improved a little in terms of performance, so I wrote my own which appears to be about 40% faster (feel free to test yourself). It's faster (1.0E-5 vs 1.7E-5 seconds per cycle) because it uses byte arrays rather than actual characters to compare values. Here's the function which returns a string array like Chip Pearson's:

    Function SplitMultiDelims2(Text As String, DelimChars As String) As String()
        '''
        'Function to split a string at multiple charachters
        'Use like SplitMultiDelims2("This:is-a,test string", ":-,")
        'Returns an array, in that example SplitMultiDelims2("This:is-a,test string", ":-,")(4) would be "test string"
        '''
        Dim bytes() As Byte
        Dim delims() As Byte
        Dim i As Long, aub As Long, ub As Long
        Dim stack As String
        Dim t() As String
        Dim tLen As Long
        tLen = Len(Text)
        If tLen = 0 Then
            Exit Function
        End If
        ReDim t(1 To tLen)                           'oversize array to avoid Redim Preserve too often
        bytes = StrConv(Text, vbFromUnicode)
        delims = StrConv(DelimChars, vbFromUnicode)
        ub = UBound(bytes)
        For i = 0 To ub
            If Contains(delims, bytes(i)) Then
                aub = aub + 1
                t(aub) = stack
                stack = ""
            Else
                stack = stack & Chr(bytes(i))
            End If
        Next i
        t(aub + 1) = stack
        ReDim Preserve t(1 To aub + 1)               'Works marginally faster if you delete this line,
        'however it returns an oversized array (which is a problem if you use UBOUND of the result,
        'but fine if you are just looking up an indexed value like the 5th string)
        SplitMultiDelims2 = t
    End Function
    
    'and a 2nd function called by the first one
    Function Contains(arr, v As Byte) As Boolean     'checks if Byte v is contained in Byte array arr
        Dim rv As Boolean, lb As Long, ub As Long, i As Long
        lb = LBound(arr)
        ub = UBound(arr)
        For i = lb To ub
            If arr(i) = v Then
                rv = True
                Exit For
            End If
        Next i
        Contains = rv
    End Function
    

    Here's the test log (his is SplitMultiDelims, mine is SplitMultiDelims2)

    > SplitMultiDelims: 1.76105267188204E-05s per cycle 'this is the important figure
    > i = 568064 iterations in 10.00390625 seconds
    >Test completed: 08/06/2017 10:23:22
    > SplitMultiDelims2: 1.05756701906142E-05s per cycle
    >i = 947044 iterations in 10.015625 seconds
    >Test completed: 08/06/2017 10:23:32
    > SplitMultiDelims2: 1.04176859354441E-05s per cycle
    >i = 960656 iterations in 10.0078125 seconds
    >Test completed: 08/06/2017 10:23:54
    > SplitMultiDelims: 1.76228941673255E-05s per cycle
    >i = 567887 iterations in 10.0078125 seconds
    >Test completed: 08/06/2017 10:24:04
    

    Run in both directions to avoid memory writing handicaps

    Test code below uses Timer so not overly precise, but good enough to demonstrate the difference

    Sub testSplit()
        Dim t As Double, dt As Double
        Dim s As String
        Dim i As Long
        t = Timer: i = 0: dt = 0: s = ""
        Do Until dt > 10                             'loop for 10 seconds
            s = SplitMultiDelims("This:is-a,test string", ":-,")(1)
            dt = Timer - t
            i = i + 1
        Loop
        Debug.Print "SplitMultiDelims: " & dt / i & "s per cycle" & vbCrLf & "i = " & i; " iterations in " & dt; " seconds" & vbCrLf & "Test completed: " & Now
        t = Timer: i = 0: dt = 0: s = ""
        Do Until dt > 10                             'loop for 10 seconds
            s = SplitMultiDelims2("This:is-a,test string", ":-,")(1)
            dt = Timer - t
            i = i + 1
        Loop
        Debug.Print "SplitMultiDelims2: " & dt / i & "s per cycle" & vbCrLf & "i = " & i; " iterations in " & dt; " seconds" & vbCrLf & "Test completed: " & Now
    End Sub
    

提交回复
热议问题