查找（一）********的句子

duquancai

菜菜行者 发表于 2016-8-27 09:36
不好意思，表述不直观，现附上图片和文档，请麻烦支支招，谢谢了！

最近比较忙！刚上论坛就收到提示，看了你这奇怪的需求，我根据你的附件写了一个，
你测试一下吧！

1. Sub shishi()
   
2.     Dim Arng As Range, Orng As Range, mt, m%, n%
   
3.     Set Arng = ActiveDocument.Content
   
4.     With CreateObject("VBScript.Regexp")
   
5.         .Global = True: .MultiLine = True
   
6.         .Pattern = "^[　（ ]*[一二三四五六七八九十]+）((?!（[一二三四五六七八九十]+）).)*\r"
   
7.         For Each mt In .Execute(Arng.Text)
   
8.             m = mt.FirstIndex: n = mt.Length
   
9.             Set Orng = ActiveDocument.Range(m, m + n)
   
10.             Orng.Font.ColorIndex = 6
    
11.         Next
    
12.         .Pattern = "[。\r]((?!^[　（ ]+[一二三四五六七八九十]+）.*?[。\r]).)+"
    
13.         For Each mt In .Execute(Arng.Text)
    
14.             m = mt.FirstIndex: n = mt.Length
    
15.             Set Orng = ActiveDocument.Range(m, m + n)
    
16.             Orng.Font.ColorIndex = wdAuto
    
17.         Next
    
18.     End With
    
19. End Sub

复制代码