求前辈们帮忙实现这样的“查找替换”

413191246se · 发表于 2017-5-15 23:10

谢谢杜先生！辛苦了！初步测试OK！——我再自己扩充一下，虽然我的《公文版》代码已经能够完成此功能，但效能没法和杜先生的代码比啊！——请杜先生赶快休息……，谢谢！
---
刚才研究杜先生以前的代码，结果，我写的
.Pattern = "^[一二三四五六七八九十百零千]+、*"这句，总把“五笔字型输入法。”这段也给带上。

duquancai · 发表于 2017-5-15 23:10

413191246se 发表于 2017-5-15 15:19
____139：C5 问题不大，你把双引号重新键入即可，如还不行，删除全部英文标点，再把中文双引号重新键入。
...

请再测试以下代码》》》》》》

Sub 例文demo()
' 针对纯文本
Dim mt, reg As Object, n&, m&, L&
sr$ = "〇一二三四五六七八九十百千万亿"
r1$ = "^[" & sr & "]+、": r2$ = "^[(（]\s*[" & sr & "]+\s*[)）]"
r3$ = "^\d+[、.．]": r4$ = "^[(（]\s*\d+\s*[)）]"
Set reg = CreateObject("vbscript.regexp")
reg.Global = True: reg.MultiLine = True
reg.Pattern = "" & r2 & "|" & r1 & "|" & r4 & "|" & r3 & ""
For Each mt In reg.Execute(ActiveDocument.Content)
      m = mt.FirstIndex: n = mt.Length
      With ActiveDocument.Range(m, m + n)
         .Expand 4: L = Len(.Text): .Collapse
         If .MoveWhile(sr, L) > 0 Then
            .Expand 4: .Font.ColorIndex = 6
         ElseIf .MoveWhile("(（", L) > 0 Then
            If .MoveWhile(sr, L) > 0 Then
                  .Expand 4: .Font.ColorIndex = 5
            Else
                  .Expand 4: .Font.ColorIndex = 11
            End If
         Else
            .Expand 4: .Font.ColorIndex = 2
         End If
      End With
Next
End Sub

duquancai · 发表于 2017-5-15 23:16

413191246se 发表于 2017-5-15 15:19
____139：C5 问题不大，你把双引号重新键入即可，如还不行，删除全部英文标点，再把中文双引号重新键入。
...

由于没有大文档，无法测试其正确与否以及无法测试两段代码的效率？

413191246se · 发表于 2017-5-15 23:31

本帖最后由 413191246se 于 2017-5-18 13:26 编辑

杜先生：今天的写法，和原来的不同啊！原来是循环遍历每个段落，今天的……没看出来，也许是整个文档。
假设文档中有表格，没有图片、图形、域等，只有表格和文字，这样的话，四种标题层次怎么一个宏完成？请再我的示例附件基础上再辛苦一下！谢谢！

413191246se · 发表于 2017-5-15 23:35

要大文档，我再提供一个大文档。（另外，如果想让文档变大，可全选文档，复制，再在文档尾部多粘贴几下即可，比如粘贴10次，20次等，再观察字数。----四种标题层次，此文档可能只有（一）这种，其它的请杜先生辛苦一下，自己键入存盘吧！预期是在 9999 范围内，每个层次都在 9999 范围内。）

demo 国家中长期教育改革和发展规划纲要.rar (29.71 KB, 下载次数: 7)

duquancai · 发表于 2017-5-16 00:08

本帖最后由 duquancai 于 2017-5-16 00:54 编辑

413191246se 发表于 2017-5-15 23:31
杜先生：今天的写法，和原来的不同啊！原来是循环遍历每个段落，今天的……没看出来，也许是整个文档。
假 ...

请你测试，我没有测试》》》》》》》》》》》》》

详见楼下》》》》》》》》》》》》

duquancai · 发表于 2017-5-16 00:43

本帖最后由 duquancai 于 2017-5-16 01:43 编辑

413191246se 发表于 2017-5-15 23:31
杜先生：今天的写法，和原来的不同啊！原来是循环遍历每个段落，今天的……没看出来，也许是整个文档。
假 ...

Sub 例文demo()
' 针对Word所有通用文档！！！（适用于：表格、图片、图形、文本框及艺术字、图文框、域、自动编号）
' 文档变化说明：所有的浮动对象将转为嵌入对象，域将被解除，自动编号将被转为手动编号！！！
算了还是按照你的要求来吧！！！

Sub 四种标题层次4中颜色()
' 文档中有表格，没有图片、图形、域等，请自行清楚段首空格！！！
Dim mt, reg As Object, n&, m&, L&
ostr$ = Replace(ActiveDocument.Content, Chr(7), "")
sr$ = "〇一二三四五六七八九十百千万亿"
r1$ = "^[" & sr & "]+、": r2$ = "^[(（]\s*[" & sr & "]+\s*[)）]"
r3$ = "^\d+[、.．]": r4$ = "^[(（]\s*\d+\s*[)）]"
Set reg = CreateObject("vbscript.regexp")
reg.Global = True: reg.MultiLine = True
reg.Pattern = "" & r2 & "|" & r1 & "|" & r4 & "|" & r3 & ""
For Each mt In reg.Execute(ostr)
      m = mt.FirstIndex: n = mt.Length
      With ActiveDocument.Range(m, m + n)
         .Expand 4: L = Len(.Text): .Collapse
         If .MoveWhile(sr, L) > 0 Then
            .Expand 4: .Font.ColorIndex = 6
         ElseIf .MoveWhile("(（", L) > 0 Then
            If .MoveWhile(sr, L) > 0 Then
                  .Expand 4: .Font.ColorIndex = 5
            Else
                  .Expand 4: .Font.ColorIndex = 11
            End If
         Else
            .Expand 4: .Font.ColorIndex = 2
         End If
      End With
Next
End Sub

13907933959 · 发表于 2017-5-16 06:49

duquancai 发表于 2017-5-15 19:34
Sub c9替换颜色()
' 9、把单独另起一行的中文注释语及句号，统一替换为绿色，段落符的黑色不变。
...

杜前辈好！

不好意思！我没有说清楚，让您误判了！抱歉！

我的意思是把附件中单独另起一行的中文注释语及句号（不包括用上逗号屏蔽了的语句及中文注释语），统一替换为绿色，段落符的黑色不变。

13907933959 · 发表于 2017-5-16 07:11

413191246se 发表于 2017-5-15 15:19
____139：C5 问题不大，你把双引号重新键入即可，如还不行，删除全部英文标点，再把中文双引号重新键入。
...

师傅好！
C5按您教的方法可运行，但运行后会删除靠近句号的一个字。

duquancai · 发表于 2017-5-16 07:48

13907933959 发表于 2017-5-16 06:49
杜前辈好！不好意思！我没有说清楚，让您误判了！抱歉！我的意思是把附件中单独另起一行的中文注释语及句 ...

Sub c9替换颜色()
' 9、把单独另起一行的中文注释语及句号，统一替换为绿色，段落符的黑色不变。
Dim mts As Object, reg As Object, n&, m&, k&, j&
Set reg = CreateObject("vbscript.regexp")
reg.Global = True: reg.Pattern = "\r\s*'[^\w]*\r"
Set mts = reg.Execute(ActiveDocument.Content)
If Not mts Is Nothing Then
      For j = mts.Count - 1 To 0 Step -1
         m = mts(j).FirstIndex: n = mts(j).Length
         With ActiveDocument.Range(m, m + n)
            .End = .End - 1: k = Len(.Text): .Collapse 0: .MoveStartUntil "'", -k
            .HighlightColorIndex = wdGreen '高亮绿色可自行改变！
         End With
      Next
End If
End Sub

		自动登录	找回密码
密码			免费注册

[求助] 求前辈们帮忙实现这样的“查找替换”