如何在VBA Excel中使用多个分隔符拆分字符串？

Question

我想使用Excel VBA将一个包含多个分隔符的字符串进行拆分。其中一个字符串是：

d1-d2 d3 d4  

我们有一个横线和一个空格作为两个分隔符。我尝试使用 split 函数，但它只能使用一个分隔符。

- infinitloop

Answer 1

你可以先对字符串进行替换，然后再进行分割：

newString = Replace(origString, "-", " ")
newArray = Split(newString, " ")

- PaulStock

Answer 2

如果要使用多个不同的分隔符进行分割，可以将这些分隔符列在一个数组中，然后使用for循环将它们替换掉，再进行分割操作：

' New delimiter
tDelimNew = "myDelimiter"

' Replace each possible delimiter
For Each tDelimOld In Array(";", " ", ".", "<==", ":", vbCr)
    tString = Replace(tString, tDelimOld, tDelimNew)
Next tDelimOld

' Remove duplicate delimiters
tString = Replace(tString, tDelimNew & tDelimNew, tDelimNew)

' Split ;)
tResult = Split(tString , tDelimNew)

- rejdrouin

---

简单但超级高效！ - konahn

Answer 3

前面的回答很好，但如果在字符串中有连续需要分割的字符，比如在所有标点符号和空格上分割“Hello, Sir! How are you doing, today?”，这会导致麻烦。在这种情况下，在Hello和Sir之间会得到一个空字符串。

为了处理这种情况，Chip Pearson提供了一个非常好用的VBA函数： http://www.cpearson.com/excel/splitondelimiters.aspx

- Michael Merchant

Answer 4

我想补充一下，我快速查看了Chip Pearson的答案，并认为在性能方面可以稍作改进，因此我自己写了一个函数，似乎比他的快约40％（可以自行测试）。它更快（每个周期1.0E-5比1.7E-5秒），因为它使用字节数组而不是实际字符来比较值。以下是该函数，它返回与Chip Pearson相似的字符串数组：

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

这是测试日志（他的是SplitMultiDelims，我的是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

为避免内存写入障碍，请双向运行。

下面的测试代码使用Timer，因此不是非常精确，但足以说明差异。

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

- Greedo

Answer 5

目前还不允许评论，但建议使用TRIM函数消除双空格并不是完全清晰的。在VBA中，TRIM函数仅删除字符串开头和结尾的空格，而不会触及字符串内部的双空格。您需要使用工作表函数来处理。

- Reged

Answer 6

在这种情况下，您可以这样做

    newString = Replace(origString, "-", " ")
    newString2 = replace(newstring, "  " , " ")
    newArray = SPlit(newString, " ")

- Dave Odle

---

如果你想避免双倍空格，可以使用 trim 函数。 - juanora

Trim函数可以去除字符串末尾和开头的空格。 - Mark Walsh