[已解决]制作VBA将特定文字和数字拆分

清秋淡水

如题，制作VBA将特定文字和数字拆分，具体要求见附件，请高手看看能否实现，谢谢。

最佳答案

月排行榜 / 总排行榜

grf1973

2017-3-12 19:42

1. Sub tt()
   
2.     arr = Range("a2:f" & [a65536].End(3).Row)  '数据区域，根据实际情况自定
   
3.     ReDim brr(1 To UBound(arr) * 10, 1 To UBound(arr, 2) + 1)
   
4.     With CreateObject("vbscript.regexp")
   
5.         .Global = True
   
6.         .Pattern = "(-?\d*[\u4e00-\u9fa5]+?)(\d+)"
   
7.         For i = 1 To UBound(arr)
   
8.             x = arr(i, UBound(arr, 2))
   
9.             Set ma = .Execute(x)
   
10.             For Each m In ma
    
11.                 n = n + 1
    
12.                 For j = 1 To UBound(arr, 2) - 1
    
13.                     brr(n, j) = arr(i, j)
    
14.                 Next
    
15.                 brr(n, j) = m.submatches(0)
    
16.                 brr(n, j + 1) = m.submatches(1)
    
17.             Next
    
18.         Next
    
19.     End With
    
20.     With Sheet2
    
21.         .Cells.ClearContents
    
22.         .[a1].Resize(, 7) = Array("日期", "工单号", "产品编号", "良品数", "不良总数", "不良分类", "数量")
    
23.         .[a2].Resize(n, UBound(brr, 2)) = brr        '显示位置自定。
    
24.         .[a2].Resize(n).NumberFormatLocal = "m月dd日"      '显示位置自定。
    
25.         .Activate
    
26.     End With
    
27. End Sub
    

复制代码

跳转到最佳答案楼层

grf1973

终于做到一道正则了。

1. Sub tt()
   
2.     arr = Range("a2:f6")  '数据区域，根据实际情况自定
   
3.     ReDim brr(1 To UBound(arr) * 10, 1 To UBound(arr, 2) + 1)
   
4.     With CreateObject("vbscript.regexp")
   
5.         .Global = True
   
6.         .Pattern = "(-?\d?[\u4e00-\u9fa5]+?)(\d+)"
   
7.         For i = 1 To UBound(arr)
   
8.             x = arr(i, UBound(arr, 2))
   
9.             Set ma = .Execute(x)
   
10.             For Each m In ma
    
11.                 n = n + 1
    
12.                 For j = 1 To UBound(arr, 2) - 1
    
13.                     brr(n, j) = arr(i, j)
    
14.                 Next
    
15.                 brr(n, j) = m.submatches(0)
    
16.                 brr(n, j + 1) = m.submatches(1)
    
17.             Next
    
18.         Next
    
19.     End With
    
20.     [a10].Resize(n, UBound(brr, 2)) = brr        '显示位置自定。
    
21. End Sub

复制代码

grf1973

.Pattern = "(-?\d*?[\u4e00-\u9fa5]+?)(\d+)"  更为妥当一些。

清秋淡水

grf1973 发表于 2017-3-11 15:16
终于做到一道正则了。

谢谢，刚试了下能解决我想要的结果，能帮我把实现后的效果放在第二个工作表中吗？ 但因我的原始数据会有很多，达上千项或以上，当我把其它的原始数据粘到表中时，就无法使用了。谢谢。我在做样板时为了更直观直接把原始数据和实现后的效果直接放在一张工作表上了，

grf1973

第2句，第20句自己改一下就OK了。

清秋淡水

grf1973 发表于 2017-3-11 20:47
第2句，第20句自己改一下就OK了。

我对VBA一窍不通，不知道怎么改呢，还请大神抽时间帮帮忙，非常感谢

grf1973

1. Sub tt()
   
2.     arr = Range("a2:f" & [a65536].End(3).Row)  '数据区域，根据实际情况自定
   
3.     ReDim brr(1 To UBound(arr) * 10, 1 To UBound(arr, 2) + 1)
   
4.     With CreateObject("vbscript.regexp")
   
5.         .Global = True
   
6.         .Pattern = "(-?\d*[\u4e00-\u9fa5]+?)(\d+)"
   
7.         For i = 1 To UBound(arr)
   
8.             x = arr(i, UBound(arr, 2))
   
9.             Set ma = .Execute(x)
   
10.             For Each m In ma
    
11.                 n = n + 1
    
12.                 For j = 1 To UBound(arr, 2) - 1
    
13.                     brr(n, j) = arr(i, j)
    
14.                 Next
    
15.                 brr(n, j) = m.submatches(0)
    
16.                 brr(n, j + 1) = m.submatches(1)
    
17.             Next
    
18.         Next
    
19.     End With
    
20.     With Sheet2
    
21.         .Cells.ClearContents
    
22.         .[a1].Resize(, 7) = Array("日期", "工单号", "产品编号", "良品数", "不良总数", "不良分类", "数量")
    
23.         .[a2].Resize(n, UBound(brr, 2)) = brr        '显示位置自定。
    
24.         .[a2].Resize(n).NumberFormatLocal = "m月dd日"      '显示位置自定。
    
25.         .Activate
    
26.     End With
    
27. End Sub
    

复制代码

清秋淡水

grf1973 发表于 2017-3-12 19:42

每次的问题都是大神你帮我解决，扣谢了、

101023

大神，你好！以下你的这句正则表达式如有字母的话提取不了

.Pattern = "(-?\d*?[\u4e00-\u9fa5]+?)(\d+)"

例子：成品工艺报废（高压不良31层间不良14DCR36电感低26错脚6）

这句子里的DCR36中的36提取不了，请帮忙修改一下，谢谢！