如何在vba excel中用多个delimeters分割字符串？

Question

我想使用Excel VBA将字符串与多个分隔符分开。一个字符串的是：

d1-d2 d3 d4 

我们有一个破折号和两个定界符的空间。我尝试了split函数，但它只能用一个分隔符来完成。

Answer 1

你可以先做的字符串REPLACE第一，然后做分割：

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

Answer 2

以前的答案是好的，但会引起你的麻烦，如果有背靠背被拆分字符就在字符串中，比如分裂“你好，先生，你今天过得怎么样？”在所有标点符号和空格上。在这种情况下，你会在Hello和Sir之间得到一个空白字符串。

处理这种情况芯片皮尔逊的使用提供了极大的VBA函数： http://www.cpearson.com/excel/splitondelimiters.aspx

Answer 3

在这种情况下，你可以做

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

Answer 4

不允许评论（还），但使用TRIM来的建议消除双重空间并不完全清楚。 VBA中的TRIM功能仅删除前导和尾随空格。它不会触及字符串内的双重空格。你将不得不使用工作表函数。

Answer 5

我补充一点，我有一个快速浏览一下芯片皮尔逊的回答，并认为这可能会在性能方面得到改进一点点，所以我写我自己这似乎是快了大约40％（随意测试你自己）。它的速度更快（1.0E-5 VS1.7E-5秒每个周期），因为它使用的字节数组，而不是实际的字符来比较值。下面是它返回一个字符串数组像芯片皮尔逊的功能：

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 

Answer 6

用几个不同的分隔符分割;列出分隔符在数组中，有一个for循环替换它们，然后分裂：

For Each tSep In Array(";", " ", ".", "<==", ":", vbCr) 
    val1 = Replace(val1, tSép, "°") 
Next tSep 
tab1 = Split(val1, "°")