WordVBA中字符串查找替换进阶

sandorn

行政法规(4项).zip (52.56 KB, 下载次数: 88)

2016-12-23 14:46 上传

点击文件名下载附件

为了收集法律法规，提高排版效率，学习高手例程，自己写了一段，请大家批评指正。
两种方法，一是全局匹配，二是逐段循环。主要作用是将 章节设置为预设好的样式，并且去掉章节标题中的空格，同时，将第X条加粗。
方法1：全局匹配公文

1. Sub 全局匹配公文()
   
2. '全局匹配,修改章节条格式
   
3. Dim T: T = Timer
   
4. If ActiveDocument.Fields.Count <> 0 Then Call FieUnlink '去除域代码
   
5. Dim patt, mStyle, bSp, bArticle '正则表达式,样式名称,是否去除中空格,是否加粗$1
   
6. patt = Array("(?:^[　 ]*)(第[零〇一二三四五六七八九十百\d]+条)(?:[　 ]*)([^　 ][^\r]*)", _
   
7. "(?:^[　 ]*)(第[零〇一二三四五六七八九十百\d]+章)(?:[　 ]*)([^　 ][^\r]*)", _
   
8. "(?:^[　 ]*)(第[零〇一二三四五六七八九十百\d]+节)(?:[　 ]*)([^　 ][^\r]*)")
   
9. mStyle = Array("公文正文", "公文1级", "公文2级")
   
10. bSp = Array(True, True, True)
    
11. bArticle = Array(True, False, False)
    
12. 
    
13. Dim crang As Object, RegEx As New RegExp '构建正则对象
    
14. RegEx.IgnoreCase = True: RegEx.Global = True: RegEx.MultiLine = True
    
15. Set crang = ActiveDocument.Content
    
16. crang.Style = ActiveDocument.Styles("公文正文") '将全文样式设置为"公文正文",此处会影响表格
    
17. 
    
18. Dim i%
    
19. For i = 0 To UBound(patt)
    
20. RegEx.Pattern = patt(i) '标题正则表达式,捕获组必须为两个
    
21. Dim mathss
    
22. If RegEx.test(crang) Then Set mathss = RegEx.Execute(crang) '测试通过则全局匹配
    
23. Dim j%, Index$, Subject$, m&, n&, oRang As Range
    
24. 
    
25. For j = mathss.Count - 1 To 0 Step -1 '匹配结果倒序循环,避免去空格影响计数
    
26. Index = mathss(j).SubMatches(0) '$1序号
    
27. Subject = IIf(bSp(i), Replace(Replace(mathss(j).SubMatches(1), "　", ""), " ", ""), mathss(j).SubMatches(1)) '$2标题,是否去掉空格
    
28. m = mathss(j).FirstIndex: n = mathss(j).Length '结果开始位置及长度
    
29. Set oRang = ActiveDocument.Range(crang.Start + m, crang.Start + m + n) '按照结果位置选择文档
    
30. oRang.Text = Index & "　" & Subject '替换选区内容
    
31. oRang.Style = ActiveDocument.Styles(mStyle(i)) '样式名称
    
32. If bArticle(i) Then
    
33. Set oRang = ActiveDocument.Range(oRang.Start, oRang.Start + Len(Index)) '选择$1内容
    
34. oRang.Font.Bold = True
    
35. End If
    
36. Next j
    
37. Next i
    
38. 
    
39. MsgBox (Timer - T) * 1000
    
40. End Sub

复制代码

方法2：逐段循环匹配公文

1. Sub 段落匹配公文()
   
2. '将全文逐段设置格式为"公文正文"，并修改章节条的格式
   
3. Dim T: T = Timer
   
4. If ActiveDocument.Fields.Count <> 0 Then Call FieUnlink '去除域代码
   
5. 
   
6. '构建正则
   
7. Dim RegEx As New RegExp
   
8. RegEx.IgnoreCase = True: RegEx.Global = False: RegEx.MultiLine = False
   
9. Dim idx
   
10. For Each idx In ActiveDocument.Paragraphs '按段落循环
    
11. If Not idx.Range.Information(wdWithInTable) Then '判断非表格内
    
12. idx.Range.Style = ActiveDocument.Styles("公文正文") '样式名称
    
13. 
    
14. Dim patt, mStyle, bSp, bArticle
    
15. patt = Array("(?:^[　 ]*)(第[零〇一二三四五六七八九十百\d]+条)(?:[　 ]*)([^　 ][^\r]*)", _
    
16. "(?:^[　 ]*)(第[零〇一二三四五六七八九十百\d]+章)(?:[　 ]*)([^　 ][^\r]*)", _
    
17. "(?:^[　 ]*)(第[零〇一二三四五六七八九十百\d]+节)(?:[　 ]*)([^　 ][^\r]*)")
    
18. mStyle = Array("公文正文", "公文1级", "公文2级")
    
19. bSp = Array(True, True, True)
    
20. bArticle = Array(True, False, False)
    
21. Dim i%
    
22. For i = 0 To UBound(patt)
    
23. RegEx.Pattern = patt(i)
    
24. Dim Index$, Subject$, m%, n%, oRang As Range
    
25. 
    
26. If RegEx.test(idx.Range) Then
    
27. Index = RegEx.Execute(idx.Range)(0).SubMatches(0) '序号
    
28. Subject = IIf(bSp(i), Replace(Replace(RegEx.Execute(idx.Range)(0).SubMatches(1), "　", ""), " ", ""), RegEx.Execute(idx.Range)(0).SubMatches(1)) '标题是否去掉空格
    
29. m = RegEx.Execute(idx.Range)(0).FirstIndex: n = RegEx.Execute(idx.Range)(0).Length
    
30. Set oRang = ActiveDocument.Range(idx.Range.Start + m, idx.Range.Start + m + n)
    
31. oRang.Text = Index & "　" & Subject
    
32. oRang.Style = ActiveDocument.Styles(mStyle(i)) '样式名称
    
33. If bArticle(i) Then
    
34. Set oRang = ActiveDocument.Range(oRang.Start, oRang.Start + Len(Index))
    
35. oRang.Font.Bold = True
    
36. End If
    
37. End If
    
38. Index = "": Subject = "": m = 0: n = 0: Set oRang = Nothing
    
39. Next i
    
40. End If
    
41. Next
    
42. 
    
43. MsgBox (Timer - T) * 1000
    
44. End Sub

复制代码

上面涉及到了一个去除域代码的语句，具体如下：

1. Function FieUnlink()
   
2. '删除域代码
   
3. Dim a%, Fie As Field
   
4. a = ActiveDocument.Fields.Count
   
5. For Each Fie In ActiveDocument.Fields
   
6. Fie.Unlink
   
7. Next
   
8. MsgBox a & "-->" & ActiveDocument.Fields.Count
   
9. End Function

复制代码

上传了文档做为附件，可以测试下。

sandorn

没有人看吗？

EH2003

有啊我在学习。

zhanglei1371

其实通配符不比正则差，速度没有几十倍的差距。保留格式时比通配符还慢。Excel用正则比较有意义，因为其没有强大的通配符。

weiyingde

duquancai 发表于 2016-11-19 23:44
不好意思，我没注意看你的代码，你不但修改了格式还添加了字符，不过你使用的通配符查找。要是比如“第一 ...

我有也些糊里糊涂。
一会儿是查找的通配符，一会儿又是正则；
而且不同程序的正则代码又有所不同，在我的印象中很乱。
我在网上搜索了一些普及知识和示例代码，没有注明是适用于那个程序。
请大侠指路，目前我学的是word、excel、ppt，这三个组件里正则的源代码的意义及其使用规则有不同的码？
若没有不同，那么学office正则，那个启蒙教程较好，能否推荐一二？
另外，这三个组件当中，为实现相同效果，在查找和替换框（勾选通配符）中输入的代码（或内容），和在VBA编辑器中输入的代码（或内容）有什么不同，免得张冠李戴。
请大虾普及一下正则知识，并指一下路。
谢谢你。

jiminyanyan

weiyingde 发表于 2017-3-23 11:57
我有也些糊里糊涂。
一会儿是查找的通配符，一会儿又是正则；
而且不同程序的正则代码又有所不同，在我 ...

http://club.excelhome.net/thread-1128647-1-1.html
看看这个，正则这东西，要学深了才有用处，若用处不多，就不用学了。

weiyingde

在所有软件当中，word、ppt用的最多，基本上都是和文字打交道，正则应该是很好的工具，弃之可惜。

leikaiyi123

小花鹿 发表于 2016-11-20 10:11
第一段代码修改了一下，排除表格，不知对不对？
Sub Word文档中修改格式()
    Dim i As Paragraph, mt,  ...

想知道修改查到的内容的部分格式的正则方法，不知是否比word的查找替换方法快多少


测试文本：

H2S H2Se HCl HBr HF HI HCN H2SO4H2S2O3 HNO3 H3PO4HAc CH3COOH H3BO3 KOH NaOH AgOH LiOH Ba(OH)2 Mg(OH)2 Ca(OH)2Al(OH)3 PH3 CH4 SiH4 NH3NaH CaH2 KH LiH NH4NO3KNO3 LiNO3 NaNO3 AgNO3 Ba(NO3)2 Be(NO3)2Mg(NO3)2 Al(NO3)3 Mn(NO3)2Fe(NO3)3 NH4Cl LiCl NaCl KCl BeCl2MgCl2 BaCl2 AlCl3 MnCl2 ZnCl2FeCl2 FeCl3 CuCl2 CuCl AgCl HgCl2 Hg2Cl2PbCl2 SnCl4 SnCl2 PCl5 CrCl3CoCl2 KBr CaCO3 LiBr NaBr MgBr2 AgBr PbBr2FeBr2 FeBr3 KI LiI NaI MgI2 AgI AgF CaF2NaF KF PbI2 Li2SO4 Na2SO4 K2SO4BeSO4 CaSO4 BaSO4 MnSO4 ZnSO4FeSO4 CuSO4 Na2SO3 K2SO3BeSO3 K2CO3 Ag2S PbS K2SiO3Na2SiO3 Cu2(OH)2CO3CaC2 C60 C70 F2 Ne Na MgAl H＋ Na＋ K＋ Li＋ Cs＋ Cu＋ Hg＋ Ag＋ Be2＋ Mg2＋ Ca2＋ Sr2＋ Ba2＋ Cu2＋ Fe2＋ Zn2＋ Mn2＋ Al3＋ Fe3＋ F- Cl- Br- I- ClO- BrO- IO- NO3- OH- ClO4- ClO3- AlO2- O2- S2- SO42- SO42- S2O32- IO3- SO32- CO32- MnO42- MnO4- PO43- NH4＋ HCO3- HS- HPO42- HSO3- HSO4- CH3COO- Ac- H2O H2O2 Na2O2K2O K2O2 KO2 Rb2O Cs2OBeO MgO CaO SrO BaO MnO2 Mn2O3 FeO Fe2O3Fe3O4 CuO Cu2O ZnO Ag2O B2O3Al2O3 CO CO2 SiO2 PbO PbO2Pb3O4 NO NO2 N2O5 P2O5P2O3 SO2 Cl2O Cl2O7N2O N2O4 N2O3 CrO3Cr2O3 HgO TiO2 SnO2 As2O3Zn(NO3)2 Fe(NO3)2Bi(NO3)3 Fe(NO3)3 Cu(NO3)2Ca(NO3)2 Sn(NO3)2 Ni(NO3)2Co(NO3)2 Li2SiO3 BeSiO3MgSiO3 CaSiO3 BaSiO3 MnSiO3 ZnSiO3CuSiO3 (NH4)3PO4 Be3(PO4)2Mg3(PO4)2 Ca3(PO4)2Mn3(PO4)2 Zn3(PO4)2FePO4 Cu2(PO4)3 Fe3(PO4)2AgH2PO4 Be(H2PO4)2Mg(H2PO4)2 Ca(H2PO4)2Ba(H2PO4)2 Li2HPO4Mg(HS)2 NH4HCO3LiHCO3 NaHCO3 KHCO3 Be(HCO3)2 Mg(HCO3)2NH3ClO Ca(HCO3)2 Ba(HCO3)2 NH4H2PO4LiH2PO4 NaH2PO4 KH2PO4Na2HPO4 K2HPO4 BeHPO4 MgHPO4CaHPO4 BaHPO4 Ag2HPO4 Mn(OH)2 Zn(OH)2 Cr(OH)3Fe(OH)2 Fe(OH)3 Sn(OH)2 Sn(OH)4 Pb(OH)2Cu(OH)2 Hg(OH)2 LiClO Be(ClO)2 Al(OH)4― Mg(ClO)2 Ca(ClO)2 KClO4 NaClO4 LiClO4 Be(ClO4)2Mg(ClO4)2 Ca(ClO4)2Li2CO3 (NH4)2SO3 Al2(SO3)3NH4ClO3 LiClO3 NaClO3 KClO3 Mn(ClO3)2Zn(ClO3)2 Ba(ClO3)2Mg(ClO3)2 (NH4)2S Cu2S SnSNH4SCN NaHSO4 KHSO4 NH4HSO4Mg(HSO4)2 Cu(HSO4)2 Na2S2O3Na2S2O4 NaHSO3 KHSO3NH4HSO3 Mg(HSO3)2 Ca(HSO3)2NaHS KHS NH4HS (NH4)2HPO4KMnO4 K2MnO4 NaAlO2 KAlO2Si P4 S2 S4 S6 S8 BeMg Ca Sr Ba Ga In Tl Si Ge Sn Pb As Sb Bi Se Te Po At He Ne Ar Kr Xe Rn Sc Ti CrMn Fe Ni Cu Zn Rb Cs As Br Kr Xe Sr Ba Pt Au Hg Ag Sn HPO3 H2CO3H2C2O4 H3AlO3 H2SiO3H4SiO4 HBrO BeCO3 MgCO3 BaCO3MnCO3 ZnCO3 FeCO3 CuCO3 Ag2CO3PbCO3 (NH4)2CO3Li3PO4 Na3PO4 K3PO4Ag3PO4 HxJp K2CrO4K2Cr2O7 Li2S Na2SK2S BeS MgS CaS BaS MnS ZnS FeS FeS2 CuS CuS2 Ag2SO4CuFeS2NaBH4 CH3COOK NaClO2 FeC2O4 (NH4)2Fe(SO4)2KI3 KIO3 NaIO3 HgS (NH4)2SO4Al2(SO4)3 Fe2(SO4)3PbSO4 BF3 SiCl4 PCl3 Si3N4Fe3C Na2Sx NaX AgX P2O5 NiSO4 Cr2(SO4)3 CdSO4HgSO4 Li2SO3 SiC SiF4 He Li Be HSCNHClO HClO2 HClO3 HClO4 HBrO3 HBrO4HIO3 HIO4 H2SO3 MgSO3CaSO3 BaSO3 MnSO3 ZnSO3 FeSO3 CuSO3Ag2SO3 KClO NaClO NH4ClO Na2CO3Cu2(OH)2CO3Ag Fe Na Al Ca Mg Sr Cd Rb Ti Se Cs Kr Ni Xe He Ne Si Ar Li Be Zn Sn Pb CuHg Pt As Mn Cr Ba Au Ga Te Bi g mol kg mL pH F2 Br2 FeI2I2 Na2O CH3 CH2 SO3HO2N e― CH3CH2 CH2CH3 C6H5ONO2 COOCH3 CH2OH CH4 CaC2O4Pb(Ac)2 Pb(NO3)2 LiBH4 Na2RC2H6 C2H2 C3H4C4H8 C6H6 C3H8C4H10 C5H12 C6H14C7H16 C8H18 C2H4C3H6 C5H10 C6H12C7H14 C4H6 C8H8C9H12 C8H10 C2H5OHC2H6O CH3COONa C2H5Cl C2H5BrCH3CHO CH3OCH3 C2H5OC2H5C6H12O6 C12H22O11C5H10O5 C3H8O2 NaCNNa2O CaCl2 CH3CH2OH CH3OHCCl4 NaNO2 KAl(SO4)2 NH2NH2NH2OH Cu(OH)2(CO3)2 KNO2 MgSO4NaAc N2H4 C6H10O5N (C6H10O5)n O3T O3 H2T H2 CL2T Cl2 CLT Cl BRT Br O2T O2 O3T O3 N2T N2 SO3T SO3

chenwenming

学习了,正好我要用到自动设置标题

chenwenming

学习了，太谢谢了，我正用得着