[已解决]如何提取区域中一个数字的次数。

tfzyes

如何提取区域中一个数字的次数。

最佳答案

月排行榜 / 总排行榜

today0427

2016-7-4 14:50

两种方法自己选择，自定义函数方法在b2单元格输入公式 =cs($A$2,B3) 然后右拉就好了

1. Function cs(bz As String, sj As Range) '自定义函数方法
   
2.      Dim reg, str$, mh
   
3.         Set reg = CreateObject("vbscript.regexp")
   
4.         str = "共(\d+)次.*?[:|,]" & bz
   
5.         reg.Pattern = str
   
6.         reg.MultiLine = True
   
7.         Set mh = reg.Execute(sj)
   
8.         cs = mh(0).submatches(0)
   
9. End Function
   
10. 
    
11. 
    
12. Sub zz()
    
13. Dim reg, str$, mh, bz, ar, j%
    
14.         Set reg = CreateObject("vbscript.regexp")
    
15.         bz = Format([a2], "00")
    
16.         str = "共(\d+)次.*?[:|,]" & bz
    
17.         reg.Pattern = str
    
18.         reg.MultiLine = True
    
19.         ar = Range("b2:g3")
    
20.         For j = 1 To UBound(ar, 2)
    
21.             Set mh = reg.Execute(ar(2, j))
    
22.             ar(1, j) = Format(mh(0).submatches(0), "'@")
    
23.         Next
    
24.         [b2].Resize(1, UBound(ar, 2)) = Application.Index(ar, 1)
    
25. 
    
26. End Sub
    

复制代码

跳转到最佳答案楼层

today0427

1. Sub zz()
   
2. Dim reg, str, mh, bz, ar, j
   
3.         Set reg = CreateObject("vbscript.regexp")
   
4.         bz = Format([a2], "00")
   
5.         str = "共(\d+)次.*?[:|,]" & bz
   
6.         reg.Pattern = str
   
7.         reg.MultiLine = True
   
8.         ar = Range("b2:g3")
   
9.         For j = 1 To UBound(ar, 2)
   
10.             Set mh = reg.Execute(ar(2, j))
    
11.             ar(1, j) = mh(0).submatches(0)
    
12.         Next
    
13.         [b2].Resize(1, UBound(ar, 2)) = Application.Index(ar, 1)
    
14. 
    
15. End Sub

复制代码

先写个sub吧，一会儿整个自定义函数，这个题目自定义函数最灵活了

today0427

一会儿自定义函数弄好了一块儿给你传附件

today0427

两种方法自己选择，自定义函数方法在b2单元格输入公式 =cs($A$2,B3) 然后右拉就好了

1. Function cs(bz As String, sj As Range) '自定义函数方法
   
2.      Dim reg, str$, mh
   
3.         Set reg = CreateObject("vbscript.regexp")
   
4.         str = "共(\d+)次.*?[:|,]" & bz
   
5.         reg.Pattern = str
   
6.         reg.MultiLine = True
   
7.         Set mh = reg.Execute(sj)
   
8.         cs = mh(0).submatches(0)
   
9. End Function
   
10. 
    
11. 
    
12. Sub zz()
    
13. Dim reg, str$, mh, bz, ar, j%
    
14.         Set reg = CreateObject("vbscript.regexp")
    
15.         bz = Format([a2], "00")
    
16.         str = "共(\d+)次.*?[:|,]" & bz
    
17.         reg.Pattern = str
    
18.         reg.MultiLine = True
    
19.         ar = Range("b2:g3")
    
20.         For j = 1 To UBound(ar, 2)
    
21.             Set mh = reg.Execute(ar(2, j))
    
22.             ar(1, j) = Format(mh(0).submatches(0), "'@")
    
23.         Next
    
24.         [b2].Resize(1, UBound(ar, 2)) = Application.Index(ar, 1)
    
25. 
    
26. End Sub
    

复制代码

tfzyes

非常感谢你的帮助，帮我省了不少时间。