想实现题号的标注,就像这样的方式,通过搜索每一行的开头,如果满足“数字+.”的形式,就把它标红 。
For i = 1 To 10000 'ActiveDocument.Paragraphs.Count
If i = daan_d Then
MsgBox "发现最大题号为:" & UBound(r)
Exit For
End If
Set a = ActiveDocument.Paragraphs(i).Range
If Not a.Information(12) Then
Debug.Print a.Text
a.SetRange a.Start, a.Start + 3
a.Select
With a.Find
.ClearFormatting
.MatchByte = False
.Forward = True
.Wrap = wdFindStop
.Text = "[0-9]{1,2}[..]"
.MatchWildcards = True
.Execute
If .Found = True Then
a.Select
a.Font.Fill.ForeColor = vbRed
Set a = Nothing
End If
' MsgBox UBound(r)
End With
End If
Next
可是,每次就会出现这样的情况。
从第一题到第九题,都可以正确查找到。到第十题就会出现问题,她会把表格中的数字和标点 查找到。
不知道问题出在哪里了?
代码稍作了修改,除了第10段匹配不到,其他没问题。不知是不是其他什么问题
Sub 通配符查找改变颜色()
For i = 1 To ActiveDocument.Paragraphs.Count
If i = daan_d Then
MsgBox "发现最大题号为:" & UBound(r)
Exit For
End If
Dim aRng As Range
Set aRng = ActiveDocument.Paragraphs(i).Range
If Not aRng.Information(12) Then
Debug.Print aRng.Text
aRng.SetRange aRng.Start, aRng.Start + 3
aRng.Select
With aRng.Find
.ClearFormatting
.MatchByte = False
.Forward = True
.Wrap = wdFindStop
.Text = "<[0-9]{1,2}[..]"
.MatchWildcards = True
.Execute
If .Found = True Then
aRng.Select
Selection.Font.Fill.ForeColor = vbRed
Set aRng = Nothing
End If
' MsgBox UBound(r)
End With
End If
Next
End Sub
执行结果
在这里提供一个其他方法,遍历段落,正则进行字符串比较:
```vb.net
Sub 遍历段落_正则匹配字符串_改颜色()
Dim pa As Paragraph, Re As Object, paStr As String
Set Re = CreateObject("vbscript.regexp") '创建正则对象,外部创建
With Re
.Pattern = "\d+?\." '匹配模式
.Global = False '最多匹配1次
End With
Dim paText As String, Result, Results, myCap
For Each pa In ActiveDocument.Paragraphs
paText = Trim(pa.Range.Text)
If Not Left(paText, 1) Like "[0-9]" Then GoTo 1 '如果段落不以数字开头,就判断下一段
Set Results = Re.Execute(paText) '执行正则匹配
If Results.Count > 0 Then '匹配结果数量大于0才执行then下面代码
Set Result = Results(0)
Debug.Print Result.firstindex, Result.Length 'Result.firstindex为匹配项的开头的索引,Result.Length为结果的字符串长度
'Debug.Print ActiveDocument.Range(Result.firstindex, Result.firstindex + Result.Length).Text
pa.Range.Select '选中段落
With Selection
.Collapse 1 '光标定位到段落开头
.MoveRight wdCharacter, Result.Length, wdExtend '从光标位置(段落开头)扩展选区,长度为匹配到的字符串长度(Result.Length)
.Font.Fill.ForeColor = vbRed
End With
End If
Set Results = Nothing
1: Next
Set Re = Nothing
End Sub
执行结果
有VBA/办公自动化问题,欢迎联系我,大家可以一起交流!
答主不错,不够最后的解决方法不够完美,因为一道题并不是只有一个段落,建议题目编号识别那一段的通配符可以写成:^p[0-9]{1,3}[..、]
如果是office的word可以写为:^13[0-9]{1,3}[..、]