正则表达式实测慢于VBA查找

413191246se · 发表于 2018-6-20 00:35

* 最近几天，又对《正则表达式》有了浓厚兴趣，搜集了一些《正则表达式》的 PDF 电子文档，准备有时间学习学习。
* 又反复复习重温了杜先生《正则表达式》关于修改格式及查找替换的原创代码及相关语录，昨天算正式入门。
* 这几天想用杜先生原来为我编的《标题2345自动设置）宏（Title2345），以期提高排版速度。
* 但刚刚我通过简单文本（一页）及巨大文本（50页）测试，发现《正则表达式》并非那么美好！
*杜先生及各位朋友如有意见，请批评指正，谢谢！
*对比如下：
* 我的//Selection/DoLoop/查找设置标题2345费时：.53秒/.39秒/8.4秒(50页巨大文本)

*杜先生/////正则表达式///查找设置标题2345费时：.71秒/.67秒/27.75秒(50页巨大文本)

zhanglei1371 · 发表于 2018-6-20 07:58

本帖最后由 zhanglei1371 于 2018-6-20 08:14 编辑

很早前我就发现了，而且文档中有域的时候正则表达式的firstindex会出现定位不准的问题。如一个文档中有很多seq的自动编号域，使用正则能正确的匹配到值value，但是选中的range却不正确。问了很多人也无法解决。

duquancai · 发表于 2018-6-20 08:52

本帖最后由 duquancai 于 2018-6-20 09:08 编辑

因为你根本没有入门，所以有这样的见解！世上本无绝对的好也无绝对的坏！！！
如果你入门了，你也不会发此帖，因为此帖就是入门级问题，最起码的“适用环境”的这个基本道理你就没搞明白，还敢说“正式入门”，你都不知道门在哪里！！！我用“三个感叹号结束吧”

413191246se · 发表于 2018-6-20 09:41

zhanglei1371 大师好！——这个“域”问题，我看杜先生语录时注意到了，应用正则前要删除所有域。
杜先生好！——我前两天，做了第一次尝试：在几段文本中查找数字，用正则，很顺利，找到了！也初步理解了“目标文本”和 Match/Matches。但在昨晚家里测试《标题2》时，发现速度有问题了。我想，可能与格式设置很详细有关吧！？因为找到正则匹配结果还不够，还要进一步设置它们的具体格式（字体、缩进等）。刚才我发现网页上有说，杜先生查找标题2时用的是“选择”法，四种模式同时查找，这可能比只匹配一种模式费时间。

413191246se · 发表于 2018-6-20 09:42

Sub Word2003VBA正则表达式_demo_标准写法()
'费时=.015'，快于i.range法=.046'！不要设置变量 m/n 会变慢！)
Dim RegEx As Object, Match As Object, Matches As Object
Set RegEx = CreateObject("VBScript.RegExp")
With RegEx
.Global = True
.IgnoreCase = True
.MultiLine = True
.Pattern = "\d+"
Set Matches = .Execute(ActiveDocument.Content)
End With
With ActiveDocument
For Each Match In Matches
.Range(Start:=Match.FirstIndex, End:=Match.FirstIndex + Match.Length).Font.Color = wdColorRed
Next
End With
Set RegEx = Nothing
Set Matches = Nothing
' Set sms = m.SubMatches
' For i = 0 To sms.Count - 1
' MsgBox sms.Item(i)
' Next i
' Set sms = Nothing
End Sub

复制代码

413191246se · 发表于 2018-6-20 09:43

Sub Word2003VBA正则表达式_demo_简化写法()
'费时=.015'，快于i.range法=.046'！不要设置变量 m/n 会变慢！)
Dim Match As Object, Matches As Object
With CreateObject("VBScript.RegExp")
.Global = True
.IgnoreCase = True
.MultiLine = True
.Pattern = "\d+"
For Each Match In .Execute(ActiveDocument.Content)
ActiveDocument.Range(Start:=Match.FirstIndex, End:=Match.FirstIndex + Match.Length).Font.Color = wdColorRed
Next
End With
End Sub

复制代码

413191246se · 发表于 2018-6-20 09:44

Sub Title2345()
'更新/启用正则/杜先生原代码----测试稍慢！
Dim doc As Document, mt As Object, i&, s$, x$, b$, c$, d$, e$
Set doc = ActiveDocument
s = Replace(doc.Content, Chr(7), "")
x = "一二三四五六七八九十百零〇○Oo千"
b = "^[" & x & "]+、"
c = "^[(（]\s*[" & x & "]+\s*[)）]"
d = "^\d+[、.．]"
e = "^[(（]\s*\d+\s*[)）]"
With CreateObject("VBScript.RegExp")
.Global = True
.MultiLine = True
.Pattern = "" & c & "|" & b & "|" & e & "|" & d & ""
For Each mt In .Execute(s)
With doc.Range(mt.FirstIndex, mt.FirstIndex + mt.Length)
If Not .Information(12) Then
.Expand 4
i = Len(.Text)
.Collapse
If .MoveWhile(x, i) > 0 Then
.Expand 4
.Style = wdStyleHeading2
.Font.Color = wdColorRed
ElseIf .MoveWhile("(（", i) > 0 Then
If .MoveWhile(x, i) > 0 Then
.Expand 4
.Style = wdStyleHeading3
.Font.NameFarEast = "楷体"
.Font.Color = wdColorPink
Else
.Expand 4
.Style = wdStyleHeading5
With .Font
.Name = "仿宋"
.Size = 16
.Color = wdColorOrange
End With
End If
Else
.Expand 4
.Style = wdStyleHeading4
With .Font
.Name = "仿宋"
.Size = 16
.Color = wdColorGreen
End With
End If
' MsgBox .Text
If .Text Like "*[：:]??*" Then
' If .Text Like "*:*" Then .Characters(InStr(.Text, ":")).Select: .Range.CharacterWidth = wdWidthFullWidth: .Move 1, 1
With doc.Range(Start:=.Characters(InStr(.Text, "：") + 1).Start, End:=.Paragraphs(1).Range.End).Font
.Name = "仿宋"
.Bold = False
.Color = wdColorBlue
End With
Else
If .Sentences.Count = 1 Then
If .Text Like "*[。：；，、！？…—.:;,!?]?" Then .Characters.Last.Previous.Delete
Else
With doc.Range(Start:=.Sentences(1).End, End:=.Paragraphs(1).Range.End).Font
.Name = "仿宋"
.Bold = False
.Color = wdColorBlue
End With
End If
End If
With .ParagraphFormat
.SpaceBeforeAuto = False
.SpaceAfterAuto = False
.SpaceBefore = 0
.SpaceAfter = 0
.LineSpacing = LinesToPoints(1.5)
.CharacterUnitFirstLineIndent = 2
.AutoAdjustRightIndent = False
.DisableLineHeightGrid = True
.KeepWithNext = False
.KeepTogether = False
End With
If .Style = "标题 2" Then
With .ParagraphFormat
.SpaceBefore = 3
.SpaceAfter = 3
End With
End If
End If
End With
Next
End With
End Sub

复制代码

413191246se · 发表于 2018-6-20 09:45

Sub Title2345()
'未用正则表达式，自编代码，稍快于正则！
Dim doc As Document, i&, s$
Set doc = ActiveDocument
For i = 1 To 4
If i = 1 Then
s = "^13[一二三四五六七八九十百零〇○Oo千]@、*^13"
ElseIf i = 2 Then
s = "^13（[一二三四五六七八九十百零〇○Oo千]@）*^13"
ElseIf i = 3 Then
s = "^13[0-9]@．*^13"
ElseIf i = 4 Then
s = "^13（[0-9]@）*^13"
End If
With Selection
.HomeKey unit:=wdStory
With .Find
.ClearFormatting
Do While .Execute(s, , , 1, , , 1)
With .Parent
.MoveStart 1, 1
If Not .Information(12) Then
If .Paragraphs.Count = 1 Then
If i = 1 Then
.Style = wdStyleHeading2
.Font.Color = wdColorRed
ElseIf i = 2 Then
.Style = wdStyleHeading3
.Font.NameFarEast = "楷体"
.Font.Color = wdColorPink
ElseIf i = 3 Then
.Style = wdStyleHeading4
With .Font
.Name = "仿宋"
.Size = 16
.Color = wdColorGreen
End With
ElseIf i = 4 Then
.Style = wdStyleHeading5
With .Font
.Name = "仿宋"
.Size = 16
.Color = wdColorOrange
End With
End If
If .Text Like "*[：:]??*" Then
If .Text Like "*:*" Then .Characters(InStr(.Text, ":")).Select: .Range.CharacterWidth = wdWidthFullWidth: .Move 1, 1
With doc.Range(Start:=.Characters(InStr(.Text, "：") + 1).Start, End:=.Paragraphs(1).Range.End).Font
.Name = "仿宋"
.Bold = False
.Color = wdColorBlue
End With
Else
If .Sentences.Count = 1 Then
If .Text Like "*[。：；，、！？…—.:;,!?]?" Then .Characters.Last.Previous.Delete
Else
With doc.Range(Start:=.Sentences(1).End, End:=.Paragraphs(1).Range.End).Font
.Name = "仿宋"
.Bold = False
.Color = wdColorBlue
End With
End If
End If
With .ParagraphFormat
.SpaceBeforeAuto = False
.SpaceAfterAuto = False
.SpaceBefore = 0
.SpaceAfter = 0
.LineSpacing = LinesToPoints(1.5)
.CharacterUnitFirstLineIndent = 2
.AutoAdjustRightIndent = False
.DisableLineHeightGrid = True
.KeepWithNext = False
.KeepTogether = False
End With
If .Style = "标题 2" Then
With .ParagraphFormat
.SpaceBefore = 3
.SpaceAfter = 3
End With
End If
End If
Else
.Tables(1).Range.Next.Select
End If
.EndKey unit:=wdLine
End With
Loop
End With
End With
Next i
End Sub

复制代码

413191246se · 发表于 2018-6-20 09:47

删除全文域只用一句代码：ActiveDocument.fields.unlink

413191246se · 发表于 2018-6-20 10:48

成功！——公文标题四个层次，不要一起处理，要分别查找处理，这样就快了！
费时对比：Title2345my宏=.80秒（传统VBA查找）------Title2345RegExp（宏）=.53秒（正则表达式，分别查找公文标题四个层次）
具体代码如下：

Sub Title2345RegExp()
Dim doc As Document, i&, s$, t$
Dim RegEx As Object, Match As Object, Matches As Object
Set doc = ActiveDocument
t = Replace(doc.Content, Chr(7), "")
For i = 1 To 4
If i = 1 Then
s = "^[一二三四五六七八九十百零〇○Oo千]+、"
ElseIf i = 2 Then
s = "^（[一二三四五六七八九十百零〇○Oo千]+）"
ElseIf i = 3 Then
s = "^\d+．"
ElseIf i = 4 Then
s = "^（\d+）"
End If
'''
Set RegEx = CreateObject("VBScript.RegExp")
With RegEx
.Global = True
' .IgnoreCase = True
.MultiLine = True
.Pattern = s
Set Matches = .Execute(t)
End With
With ActiveDocument
For Each Match In Matches
With .Range(Start:=Match.FirstIndex, End:=Match.FirstIndex + Match.Length)
.Expand 4
' .Select
If Not .Information(12) Then
If i = 1 Then
.Style = wdStyleHeading2
.Font.Color = wdColorRed
ElseIf i = 2 Then
.Style = wdStyleHeading3
.Font.NameFarEast = "楷体"
.Font.Color = wdColorPink
ElseIf i = 3 Then
.Style = wdStyleHeading4
With .Font
.Name = "仿宋"
.Size = 16
.Color = wdColorGreen
End With
ElseIf i = 4 Then
.Style = wdStyleHeading5
With .Font
.Name = "仿宋"
.Size = 16
.Color = wdColorOrange
End With
End If
If .Text Like "*[：:]??*" Then
If .Text Like "*:*" Then .Characters(InStr(.Text, ":")).Select: .CharacterWidth = wdWidthFullWidth: .Move 1, 1
With doc.Range(Start:=.Characters(InStr(.Text, "：") + 1).Start, End:=.Paragraphs(1).Range.End).Font
.Name = "仿宋"
.Bold = False
.Color = wdColorBlue
End With
Else
If .Sentences.Count = 1 Then
' MsgBox .Text
If .Text Like "*[。：；，、！？…—.:;,!?]?" Then .Characters.Last.Previous.Delete
Else
With doc.Range(Start:=.Sentences(1).End, End:=.Paragraphs(1).Range.End).Font
.Name = "仿宋"
.Bold = False
.Color = wdColorBlue
End With
End If
End If
With .ParagraphFormat
.SpaceBeforeAuto = False
.SpaceAfterAuto = False
.SpaceBefore = 0
.SpaceAfter = 0
.LineSpacing = LinesToPoints(1.5)
.CharacterUnitFirstLineIndent = 2
.AutoAdjustRightIndent = False
.DisableLineHeightGrid = True
.KeepWithNext = False
.KeepTogether = False
End With
If .Style = "标题 2" Then
With .ParagraphFormat
.SpaceBefore = 3
.SpaceAfter = 3
End With
End If
End If
End With
Next
End With
' Set RegEx = Nothing
' Set Matches = Nothing
Next i
End Sub

复制代码

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

[讨论] 正则表达式实测慢于VBA查找