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

爱疯

1. 
   
2. Sub a()
   
3.     Dim x$
   
4.     x = " a bc def  g    hi "
   
5.     MsgBox zh(x, " ", ",")
   
6. End Sub
   
7. 
   
8. Function zh(x, y, z) '转为形如"a,bc,def,g,hi"这样的字符串
   
9. End Function

复制代码

我觉得这是一个常见题型，学习了，以后只需套用。
正在想，请问怎么写zh好？谢谢！

最佳答案

月排行榜 / 总排行榜

FF7

2012-2-18 23:42

支持爱疯的工作，我也写一个供参考！

1. Function zh(x, y, z) '转为形如"a,bc,def,g,hi"这样的字符串
   
2.   x = Trim(x)
   
3.   Do While InStr(x, y & y) > 0
   
4.      x = Replace(x, y & y, y)
   
5.   Loop
   
6.   zh = Replace(x, y, z)
   
7. End Function

复制代码

跳转到最佳答案楼层

爱疯

2#、6#、9#、10#、11#，修改后，可得到正确结果。
13#、14#、21#，还没改，作者能改改就好啦。

当大数据量时，正则就有优势了

我修改的2楼的正则表达式，不知能否用1个表达式，不要后面的判断来截取，就好了。希望高手指点下！
一起测第4次更新.rar (14.28 KB, 下载次数: 5)

2012-2-20 15:27 上传

点击文件名下载附件
一起测第5次更新.rar (18.39 KB, 下载次数: 7)

2012-2-20 23:19 上传

点击文件名下载附件 ：只需关注最后1次更新，前面的留着
一起测第6次更新.rar (16.02 KB, 下载次数: 3)

2012-2-21 14:34 上传

点击文件名下载附件 ：加入了40#
一起测第7次更新.rar (20.43 KB, 下载次数: 5)

2012-2-21 19:43 上传

点击文件名下载附件 ：更新了13#。因为发现13#首位总多了个"|"，所以我给加了句  zh13 = Mid(zh13, 2)

wcymiss

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

复制代码

这样行不行？

爱疯

wcymiss 发表于 2012-2-18 22:40
这样行不行？

谢谢wcymiss！

能得到正确结果。
因为这可能是我们遇到问题中的某一步变化，也许要循环多次。所以希望尽量不依靠正则，想学习不用正则的办法。
对了，2楼中可以用x = Trim(x)，来去除两头的空格。

happym8888

1. Sub a()
   
2.     Dim x$
   
3.     x = " a bc def  g    hi "
   
4.     MsgBox zh(x, " ", ",")
   
5. End Sub
   
6. Function zh(x, y, z) '转为形如"a,bc,def,g,hi"这样的字符串
   
7. If Len(x) > 0 Then
   
8. For i = 1 To Len(x)
   
9.     MyStr = Mid$(x, i, 1)
   
10.     If MyStr = y Then
    
11.        If i <> 1 And i <> Len(x) And Mid$(x, i + 1, 1) <> y Then zh = zh & z
    
12.     Else
    
13.        zh = zh & MyStr
    
14.     End If
    
15. Next i
    
16. End If
    
17. End Function

复制代码

爱疯

happym8888 发表于 2012-2-18 23:15

谢谢happym8888!
能得到正确结果，学习了！
因为是个纯学习问题，我就稍后再评好了，我也好再想想。谢谢哦！

happym8888

1. Function zh(x, y, z)
   
2. x = Trim(x)
   
3. If Len(x) > 0 Then
   
4. For i = 1 To Len(x)
   
5. MyStr = Mid$(x, i, 1)
   
6. If MyStr = y Then
   
7. If Mid$(x, i + 1, 1) <> y Then zh = zh & z
   
8. Else
   
9. zh = zh & MyStr
   
10. End If
    
11. Next i
    
12. End If
    
13. End Function

复制代码

happym8888

爱疯 发表于 2012-2-18 23:24
谢谢happym8888!
能得到正确结果，学习了！
因为是个纯学习问题，我就稍后再评好了，我也好再想想。谢谢 ...

您客气了，向你学习！

wenchduan

来学习一下哈

FF7

支持爱疯的工作，我也写一个供参考！

1. Function zh(x, y, z) '转为形如"a,bc,def,g,hi"这样的字符串
   
2.   x = Trim(x)
   
3.   Do While InStr(x, y & y) > 0
   
4.      x = Replace(x, y & y, y)
   
5.   Loop
   
6.   zh = Replace(x, y, z)
   
7. End Function

复制代码

兰色幻想

1. Function zh(x, y, z) '转为形如"a,bc,def,g,hi"这样的字符串
   
2.   Dim arr, arr1(), k, m
   
3.   arr = Split(x, y)
   
4.   For m = 0 To UBound(arr)
   
5.     If Not (arr(m) = y Or arr(m) = "") Then
   
6.       k = k + 1
   
7.       ReDim Preserve arr1(1 To k)
   
8.       arr1(k) = arr(m)
   
9.     End If
   
10.   Next m
    
11.   zh = Join(arr1, z)
    
12. End Function
    

复制代码