求字符串提取，最好是正则表达式的VBA。

yyyydddd8888

学习几位老师的好方法，利用submatches写了一个正则表达式来获取多个子匹配：
正则子匹配选择多项.zip (9.69 KB, 下载次数: 15)

2014-4-13 20:49 上传

点击文件名下载附件

1. Option Explicit
   
2. 
   
3. Sub 提取()
   
4. Dim arr, brr(1 To 100000, 1 To 4), reg As Object, i&, mat As Object, st$
   
5. arr = Sheet1.Range("a2:a" & Range("a" & Rows.Count).End(3).Row)
   
6. Set reg = CreateObject("vbscript.regexp")
   
7. st = "(\d+.*?)([A-Z]\d{3,4})(\d{0,2}[A-Z]+)"
   
8. With reg
   
9.     .ignorecase = False
   
10.     For i = 1 To UBound(arr)
    
11. '        .Pattern = "(^.+?)[A-Z].+[A-Z](.+$)"
    
12. '        Set mat = .Execute(arr(i, 1))
    
13. '            brr(i, 1) = mat(0).submatches(0)
    
14. '            brr(i, 4) = mat(0).submatches(1)
    
15. '        Set mat = Nothing
    
16.         If Len(arr(i, 1)) > 20 Then
    
17.            st = "(^.*?)([A-Z]\d{4})(\d?[A-Z]+)(.*$)"
    
18.         Else
    
19.            st = "(^.*?)([A-Z]\d{3})(\d{2}[A-Z]+)(.*$)"
    
20.         End If
    
21.            .Pattern = st
    
22.            Set mat = .Execute(arr(i, 1))(0)
    
23.                brr(i, 1) = mat.submatches(0)
    
24.                brr(i, 2) = mat.submatches(1)
    
25.                brr(i, 3) = mat.submatches(2)
    
26.                brr(i, 4) = mat.submatches(3)
    
27.            Set mat = Nothing
    
28.     Next i
    
29. End With
    
30.     Sheet1.Range("b2").Resize(i + 5, 4) = ""
    
31.     Sheet1.Range("b2").Resize(i - 1, 4) = brr
    
32. End Sub
    

复制代码

yyyydddd8888

提取重复分组的用法：submatches(0)提取的是最后一次重复的分组：pattern="(.*?\s){3}"      
reg.execute()(0).submatches(0)   提取的是第3次重复的组。
提取重复分组.zip (11.09 KB, 下载次数: 21)

2014-4-13 21:38 上传

点击文件名下载附件

1. Sub 提取第二个空格后的字符串()
   
2. Dim reg As Object, st$
   
3. Set reg = CreateObject("vbscript.regexp")
   
4. st = "(.*?\s){3}"
   
5. reg.ignorecase = False
   
6. reg.Pattern = st
   
7. Range("d12") = reg.Execute(Range("a12"))(0).submatches(0)
   
8. 
   
9. End Sub
   

复制代码

datongye

Sub rete()
Set reg = CreateObject("vbscript.regexp")
maxrow = Cells(65536, 1).End(xlUp).Row
With reg
  .Global = True
  .Pattern = "^(\d+[A-Z]+){3}.*"
   For i = 1 To maxrow
  Cells(i, 3) = .Replace(Cells(i, 1), "$1")
  Next i
End With

End Sub

zy75747

收藏 。好东西 谢谢各位大师

lcjy11185

正则表达式。多方法。做个记号

renkangjizhen

大神啊！答案全部正确！

renkangjizhen

Sub test()
r = Range("a1", [a1].End(4))
With CreateObject("VBSCRIPT.REGEXP")
  .Pattern = "(\d+\D+){2}(\d+\D+).*"
  For i = 1 To UBound(r)
    r(i, 1) = .Replace(r(i, 1), "$2")
  Next
  Range("b1").Resize(UBound(r)) = r
End With
End Sub
这种方法简便，适合大量数据处理，受教了

wang-way