[已解决]文字及数字分离依序提取vba模块求

icenotcool

各位老师好，本人有一堆名字组合一起，想求取一个模块依序分离提取出来，谢谢 示例.rar (6.3 KB, 下载次数: 11)

2015-11-3 11:34 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

grf1973

2015-11-3 14:05

没注意中间有个“女（30人）：”，代码小改一下

1. Sub 提取()
   
2.     x = Sheets("源表").[a1]
   
3.     x = Replace(x, "：", "、")
   
4.     xrr = Split(x, "、")
   
5.     ReDim brr(UBound(xrr), 1 To 2)
   
6.     For i = 0 To UBound(xrr)
   
7.         y = xrr(i)
   
8.         brr(i, 1) = Split(y, "（")(0)
   
9.         brr(i, 2) = Val(Split(y, "（")(1))
   
10.     Next
    
11.     Sheets("提取").[a2].Resize(i, 2) = brr
    
12. End Sub

复制代码

跳转到最佳答案楼层

新手重上路

现在VBA的依赖性太厉害了。。简单操作就能解决的问题为什么非要VBA呢？
分列-转置-分列-替换，搞定

icenotcool

新手重上路 发表于 2015-11-3 11:44
现在VBA的依赖性太厉害了。。简单操作就能解决的问题为什么非要VBA呢？
分列-转置-分列-替换，搞定

你看看清楚我的示例再说，同学

悠悠05

{:22:}是不是这样

grf1973

1. Sub 提取()
   
2.     x = Sheets("源表").[a1]
   
3.     xrr = Split(x, "、")
   
4.     ReDim brr(UBound(xrr), 1 To 2)
   
5.     For i = 0 To UBound(xrr)
   
6.         y = xrr(i)
   
7.         brr(i, 1) = Split(y, "（")(0)
   
8.         brr(i, 2) = Val(Split(y, "（")(1))
   
9.     Next
   
10.     Sheets("提取").[a2].Resize(i, 2) = brr
    
11. End Sub
    

复制代码

grf1973

不会用正则，简单用split分离。

grf1973

没注意中间有个“女（30人）：”，代码小改一下

1. Sub 提取()
   
2.     x = Sheets("源表").[a1]
   
3.     x = Replace(x, "：", "、")
   
4.     xrr = Split(x, "、")
   
5.     ReDim brr(UBound(xrr), 1 To 2)
   
6.     For i = 0 To UBound(xrr)
   
7.         y = xrr(i)
   
8.         brr(i, 1) = Split(y, "（")(0)
   
9.         brr(i, 2) = Val(Split(y, "（")(1))
   
10.     Next
    
11.     Sheets("提取").[a2].Resize(i, 2) = brr
    
12. End Sub

复制代码

雨吧

1. Sub 提取()
   
2.     Dim arr, brr(), s$$, i%
   
3.     arr = Split(Replace(Replace(Replace(Sheet1.Range("a1"), "。", "、"), "：", "：、"), vbLf, ""), "、")
   
4.     ReDim brr(UBound(arr), 1)
   
5.     For i = 0 To UBound(arr)
   
6.         If arr(i) Like "*：*" Then
   
7.             brr(i, 0) = arr(i)
   
8.         Else
   
9.             brr(i, 0) = Split(arr(i), "（")(0)
   
10.             brr(i, 1) = Replace(Split(arr(i), "（")(1), "）", "")
    
11.         End If
    
12.     Next
    
13.     Sheet2.Range("a2").Resize(i, 2) = brr
    
14. End Sub

复制代码

示例.rar (13.98 KB, 下载次数: 3)

2015-11-3 14:06 上传

点击文件名下载附件

icenotcool

谢谢各位老师及同学的帮助，问题得到解决了，谢谢！