[已解决]转为以逗号分隔的字符串

爱疯

1. Function zh31(x As String, y As String, z As String) As String
   
2.     Dim arr As Variant
   
3.     Dim arr1() As String
   
4.     Dim k As Long
   
5.     Dim m As Long
   
6.     Dim s As Long       '累计每个数组元素的字符数
   
7.     Dim u As Long       '为提速而设的变量
   
8.     Dim n As String     '为提速而设的变量
   
9.     arr = Split(x, y)
   
10.     u = UBound(arr)
    
11.     ReDim arr1(u)
    
12.     For m = 0 To u    '遍历所有字符
    
13.         n = arr(m)
    
14.         If Len(n) > 0 Then
    
15.             arr1(k) = n
    
16.             k = k + 1
    
17.             s = s + Len(n) + 1
    
18.         End If
    
19.     Next m
    
20.     zh31 = Join(arr1, z)
    
21.     zh31 = Left(zh31, s - 1)
    
22. End Function

复制代码

根据10#修改的，原来以为无所谓的改变，发现有提高真高兴

Dj_soo

个人感觉2L的是最有效率的方法,两次替换加上Trim最合适,代码可以稍微精简一些,利用前后空格可以被trim的特性:

1. Function zh(x, y, z) '转为形如"a,bc,def,g,hi"这样的字符串
   
2.     With CreateObject("vbscript.regexp")
   
3.         .Global = True
   
4.         .Pattern = "" & y
   
5.         x = Trim(.Replace(x, " "))
   
6.         .Pattern = " +"
   
7.         zh = .Replace(x, z)
   
8.     End With
   
9. End Function

复制代码

Dj_soo

不过对于这样的中间有空格的把空格也替换掉,不知道算不算不符合题意

1. Sub a()
   
2.     Dim x$
   
3.     x = "| a | w||| bc|| def|g  hi||||"
   
4.     MsgBox zh(x, "|", ",")
   
5. End Sub
   
6. 
   
7. Function zh(x, y, z) '转为形如"a,bc,def,g,hi"这样的字符串
   
8.     With CreateObject("vbscript.regexp")
   
9.         .Global = True
   
10.         .Pattern = "" & y
    
11.         x = Trim(.Replace(x, " "))
    
12.         .Pattern = " " & "+"
    
13.         zh = .Replace(x, z)
    
14.     End With
    
15. End Function

复制代码

爱疯

Dj_soo 发表于 2012-2-21 09:53
个人感觉2L的是最有效率的方法,两次替换加上Trim最合适,代码可以稍微精简一些,利用前后空格可以被trim的特性 ...

谢谢DJ，你来晚了哈

题目略为变了下（替换前不是空格，而是某个字符），因为替换前如果是某个字符（比如：是"|"），题目适用性会大些。

按此新要求，24楼整理了许多回复。学习各家的方法，感觉很立体{:011:}

Dj_soo

爱疯 发表于 2012-2-21 10:04
谢谢DJ，你来晚了哈

题目略为变了下（替换前不是空格，而是某个字符），因为替换前如果是某个字符（比 ...

那还是喜欢2L的,我觉得考虑的很全面啊!

Dj_soo

另外10L兰版的方法数据特别大的时候会出错的,join的个数好像有限制.

Dj_soo

一个pattern两次替换:

1. Function zh(x, y, z)    '转为形如"a,bc,def,g,hi"这样的字符串
   
2.     With CreateObject("vbscript.regexp")
   
3.         .Global = True
   
4.         .Pattern = "(^" & y & "+|" & y & "+$)|(" & y & "+)"
   
5.         zh = .Replace(.Replace(x, "$2"), "$1,")
   
6.     End With
   
7. End Function

复制代码

Dj_soo

附上测试代码:

1. Sub a()
   
2.     Dim x$
   
3.     x = "||. a |||||b|c| |||def | g |  ||||| hi |"
   
4.     MsgBox zh(x, "|", ",")
   
5. End Sub

复制代码

一般分隔符我只考虑符合不考虑有字母出现情况,所以全都用了转义字符"\"

爱疯

Dj_soo 发表于 2012-2-21 10:44
一个pattern两次替换:

(^\|+|\|+$)|(\|+)

这样，我才看清楚了你的正则表达式。对于分支条件，(\|+)必须放在后面。不然从左往右，先被匹配了，就不再管其它的条件了。所以这里关注的主要是左边的条件。
橙色+和蓝色+，都是懒惰模式吧？类似下面+的作用
Sub Test5()
    Dim regex As Object
    Set regex = CreateObject("VBScript.RegExp")
    With regex
        .Global = True
        .Pattern = "a+a"
        MsgBox .Test("aab")   '返回true
        MsgBox .Test("aba")   '返回false
    End With
End Sub


接着说下DJ的替换，zh = .Replace(.Replace(x, "$2"), "$1,")，变成两句，我才好理解：
zh2 = .Replace(x, "$2")
zh2 = .Replace(zh2, "$1,")

第1步："$2"表示将第2个括号，即(\|+)里所有匹配到的内容。把x中匹配内容，替换为"$2"的匹配模式能匹配到的内容。
第2步：同理"$1"。"$1,"没这么测试过。。。。晕呀，按照第1步的含义，我换做：zh2 = .Replace(zh2, z)，也是可以的。即我第1步的理解是对的呀。是我，第2步怎么也不会去想成"$1,"，整人啊。。。。

这样，2#终于可以用一个正则表达式。坏消息就是，在中数据量和多数据量（24#）测试中，均无法最快了。

吕?布

这个代码比较长

Function lvbu2(x As String, y As String, z As String) As String
    Dim arrByteX() As Byte
    Dim arrByteY() As Byte

    Dim arrS() As String
   
   
    Dim bReserve As Boolean
    Dim lStartPos As Long
    Dim lReserveLen As Long
    Dim lPart As Long

    Dim i As Long
    ReDim arrS(1 To Len(x)) As String
    arrByteX = x
    arrByteY = y

    For i = LBound(arrByteX) To UBound(arrByteX) Step 2
        If bReserve Then
            If arrByteY(0) = arrByteX(i) Then
                If arrByteY(1) = arrByteX(i + 1) Then
                    arrS(lPart) = Mid(x, lStartPos, lReserveLen)
                    bReserve = False
                    lReserveLen = 0
                Else
                    lReserveLen = lReserveLen + 1
                End If
            Else
                lReserveLen = lReserveLen + 1
            End If
        Else
            If arrByteY(0) <> arrByteX(i) Then
                bReserve = True
                lReserveLen = 1
                lPart = lPart + 1
                lStartPos = i / 2 + 1
            ElseIf arrByteY(1) <> arrByteX(i + 1) Then
                bReserve = True
                lReserveLen = 1
                lPart = lPart + 1
                lStartPos = i / 2 + 1
            End If
        End If
    Next i
    ReDim Preserve arrS(1 To lPart) As String
    lvbu2 = VBA.Join(arrS, z)
End Function