正则表达式与超链接ActiveDocument.Range和Format。

4
Tobias的答案似乎是正确的。只想补充一下,我刚意识到量词在字符类中是没有意义的。我还注意到同事的电子邮件中数字前面和美元符号后面经常有一个空格,所以下面是更好的正则表达式(适用于美元金额):
RegExp.Pattern = "\$\s*([\,\d]*(?:\.\d{2})?)"

在这个灵感的基础上: 超链接范围的起始点和结束点分别指的是什么? 得出了以下结果:

Sub trueUpAttempt()
Dim OrigLength As Long
Debug.Print ActiveDocument.Characters.Count

Dim SelStart As Long
Dim SelEnd As Long
Dim SelLength As Long

Dim rHyperlink As Range
Dim wdHyperlink As Hyperlink
    For Each wdHyperlink In ActiveDocument.Hyperlinks
        Set rHyperlink = wdHyperlink.Range
        'Debug.Print rHyperlink.Start
        'Debug.Print rHyperlink.End
        'Debug.Print rHyperlink.End - rHyperlink.Start
        Debug.Print rHyperlink.End - rHyperlink.Start - Len(rHyperlink)
        'there's got to be some way to true up the character offset, even if its ugly
        Debug.Print ActiveDocument.Characters.Count + rHyperlink.End - rHyperlink.Start - Len(rHyperlink)
    Next
End Sub

这不是一个解决方法,但我认为这是一个调整字符偏移的概要。这是因为Word在计算例如{HYPERLINK "http://www.smithany.com"} http://www.smithany.com 中的所有62个字符。 编辑 2023年7月22日尝试Tobais的建议的相反方式:
Sub DollarHighlighter2()
Set regExp = New regExp
Dim objMatch As Match
Dim colMatches As MatchCollection
Dim offsetEnd As Long
offsetEnd = Selection.End
regExp.Pattern = "\$([\,\d{1,3}]*(?:\.\d{2})?)"
regExp.Global = True
Set allMatches = regExp.Execute(Selection.text)   ' Execute search.
For i = allMatches.Count - 1 To 0 Step -1
    'MsgBox allMatches.Item(i)
    ActiveDocument.Range(offsetEnd - allMatches.Item(i).FirstIndex, End:=offsetEnd - allMatches.Item(i).FirstIndex + allMatches.Item(i).Length).FormattedText.HighlightColorIndex = wdYellow
Next
End Sub

但是这个问题似乎仍然存在与链接以及其他内容的类似问题。我还尝试了相同的范围确定向前的方法,但是反向循环匹配时也遇到了类似的问题。
这里有一个示例文件的工作链接(无ssl):http://www.smithany.com/exampleDollarHighliter.docx 原文: 我看到了几篇其他的StackOverflow帖子,比如这篇: 如何在Word中使用/启用(RegExp对象)正则表达式使用VBA(宏) 关于在Microsoft Word中使用VBA和Microsoft VB脚本正则表达式5.5参考的正则表达式的使用。
这对我有所帮助,我在Word中使用它来突出显示美元金额。
Sub dollarHighlighter()
Set regExp = New regExp
Dim objMatch As Match
Dim colMatches As MatchCollection
Dim offsetStart As Long
offsetStart = Selection.Start
regExp.Pattern = "\$([\,\d{1,3}]*(?:\.\d{2})?)"
regExp.Global = True
Set colMatches = regExp.Execute(Selection.Text)   ' Execute search.
For Each objMatch In colMatches   ' Iterate Matches collection.
  Set myRange = ActiveDocument.Range(objMatch.FirstIndex + offsetStart, 
    End:=offsetStart + objMatch.FirstIndex + objMatch.Length)
  myRange.FormattedText.HighlightColorIndex = wdYellow
Next
   End Sub

虽然这在文本中的一系列金额上按预期工作(在大部分情况下 - 在其不完美之处,正则表达式故意有些宽松),但当Word文档中存在超链接时,它并不像预期那样工作。
在这种情况下,突出显示的字符偏移似乎以一种不太可预测的方式发生了变化。我猜想这是因为文档.xml源文件中有很多新的xml/css。
最终,我主要的问题是,即使Word文档包含超链接,我能否使用正则表达式来突出显示文档内容?这是一个偏移问题,还是应该在压缩的xml上运行正则表达式,重新压缩并重新打开以获得更好的结果?因为当我在源代码上测试各种正则表达式变体时,我得到了预期的结果,但在格式化Word范围时却没有。
我也在这里问过这个问题:https://social.msdn.microsoft.com/Forums/en-US/3a95c5e4-9e0c-4da9-970f-e0bf801c3170/macro-for-a-regexp-search-replace?forum=isvvba&prof=required,但意识到那是一个古老的帖子...
根据下面的问题,这里有一些可能有用的链接: 一个示例文档 http://www.smithany.com/test.docx 步骤1 http://www.smithany.com/wordusd1.jpg 步骤2 http://www.smithany.com/wordhighlighterrun.jpg 以及发生了什么 http://www.smithany.com/whatactuallyhappens.jpg 临时解决方法:如下所建议,如果不堆叠循环,Word的通配符查找速度很快。试试这个方法:
Sub Macro2()
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
Selection.Find.Replacement.highlight = True
With Selection.Find
    .Text = "$[0-9,]{1,}"
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchAllWordForms = False
    .MatchSoundsLike = False
    .MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
Selection.Find.Replacement.highlight = True
With Selection.Find
    .Text = "$[0-9,]{1,}.[0-9]{2,3}"
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchAllWordForms = False
    .MatchSoundsLike = False
    .MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll

结束子程序

基本上是获取所有突出显示的金额。 话虽如此,像匹配各种日期格式这样的复杂表达式可能会变得混乱,但我想一步一步地完成它们是完全可能的。


请提供一个输入和期望的匹配的示例。 - 41686d6564 stands w. Palestine
5252。 $52.52 ($) ($52) ($5.52)以上内容应突出显示任何美元符号$后跟一个数字。当存在超链接,例如www.adsfasdf.com或asdf@asdfasdf.com,其前面或后面是任意内容$123.12时,某些看似随机的偏移会导致不正确的内容被突出显示,仅在MS Word中。 - Allan
1
简单来说,您不能依赖Range.Start.End属性作为“设置”值。Word文档中有太多的非打印(和不可见)字符,这些字符无法被计算在内。对于超链接,它们是字段代码。Word的通配符查找不起作用吗? - Cindy Meister
1
你不能使用Word中的通配符查找吗?在你的MSDN帖子中,你似乎认为它不能用于查找日期或美元金额,但这两种情况都不是真的。在Word中使用通配符查找将没有问题地正确识别范围。 - macropod
这篇 MSDN 文章不是我的 OP,我只是回复了一下。如果没有最低限度的修改,似乎这将非常困难。尝试使用这个正则表达式(很丑陋,但似乎很有效)。在 Word 中,即使可能,也会是一个噩梦: (一月|二月|三月|四月|五月|六月|七月|八月|九月|十月|十一月|十二月|Jan[-.]?|Feb[-.]?|Mar[-.]?|Apr[-.]?|Jun[-.]?|Jul[-.]?|Aug[-.]?|Sept?[-.]?|Oct[-.]?|Nov[-.]?|Dec[-.]?)|(\d{1,2})/-(?:[/- ])?(\d{4}|\d{2})?\s?|(\d{1,2})[,\s] [,\s'](\d{4}|\d{2})|(\d{1,2})[thsnrd]{0,2}[,\s (?=\b)][,\s'](\d{4}|\d{2})? - Allan
2个回答

3

多年来我没有接触VBA,但是我想这就像骑自行车一样。

无论如何,这里有一个子程序可以帮助您。它基于Cindy Meister的建议,通过使用匹配模式集合填补正则表达式和通配符查找之间的差距,从而实现了可选部分的匹配。

首先是通配符匹配:$[0-9,]{1,}$[0-9,]{1,}.[0-9]{2}

毕竟并没有那么不同,是吗?然而,为了考虑可选的小数部分,我必须使用两个模式。

以下是该例程:

Sub WildcardsHighlightWords()
    Dim Word As Range
    Dim WildcardCollection(2) As String
    Dim Words As Variant
    WildcardCollection(0) = "$[0-9,]{1,}"
    WildcardCollection(1) = "$[0-9,]{1,}.[0-9]{2}"
    Options.DefaultHighlightColorIndex = wdYellow
    'Clear existing formatting and settings in Find
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    'Set highlight to replace setting.
    Selection.Find.Replacement.Highlight = True
    'Cycle through document and find wildcards patterns, highlight words when found
    For Each Word In ActiveDocument.Words
        For Each WildcardsPattern In WildcardCollection
            With Selection.Find
                .Text = WildcardsPattern
                .Replacement.Text = ""
                .Forward = True
                .Wrap = wdFindContinue
                .Format = True
                .MatchCase = False
                .MatchWholeWord = False
                .MatchWildcards = True
                .MatchSoundsLike = False
                .MatchAllWordForms = False
            End With
            Selection.Find.Execute Replace:=wdReplaceAll
        Next
    Next
End Sub

如果需要,扩展或修改此方法应该很容易。

这将按照我期望的方式突出显示金额:

enter image description here

注意:量词{n,m}中的分隔符在所有本地化版本中都不相同,例如,在德语版本中为{n;m}。


由于某些原因,在较大的文档上,我认为任何多页文档,您上面的Word通配符子程序集似乎会挂起。我会仔细查看并尝试使其在较大的文档中正常工作,这样我就可以将其标记为答案。当然,我的目标是能够使用来自其他来源的现有模式来匹配日期(数字和拼写的月份)、电子邮件等,这通常需要比Word提供的更广泛的模式匹配。 - Allan

2

更新于2023年7月26日: 如果你逐段查看文档,你可以轻松地回避所有这些问题。然而,在你的情况下,这是行得通的,因为正则表达式匹配仅限于段落边界!

鉴于这种限制,以下vba代码将起作用:

Sub DollarHighlighter4()
    
    '26.07.2023, works within tables
    Dim RegExp As RegExp
    Dim allMatches As MatchCollection
    Dim wdPar As Paragraph
    Dim rngPar, rngDoc, rngFormat As Range
    Dim i, intA, intB As Integer
    
    Set rngDoc = ActiveDocument.Range
    
    Set RegExp = New RegExp
    RegExp.Pattern = "\$([\,\d{1,3}]*(?:\.\d{2})?)"
    RegExp.Global = True

    For Each wdPar In rngDoc.Paragraphs
        
        Set rngPar = wdPar.Range
        ' Get all matches, within current paragraph
        Set allMatches = RegExp.Execute(rngPar)
        
        ' Highlight all matches, within current paragraph
        For i = allMatches.Count - 1 To 0 Step -1
            intA = allMatches.Item(i).FirstIndex
            intB = intA + allMatches.Item(i).Length
            Set rngPar = wdPar.Range ' Always reset range to whole content
            Set rngFormat = wdPar.Range 'current Paragraph.Range
            ' Adjust text-range to actual regex-match
            ' Character-address refers to current paragraph
            rngFormat.SetRange Start:=rngPar.Characters(intA + 1).Start, _
                End:=rngPar.Characters(intB).End
            ' Perform action to range
            rngFormat.FormattedText.HighlightColorIndex = wdYellow
        Next

    Next wdPar
    
    'Finish
    Set rngFormat = Nothing
    Set rngPar = Nothing
    Set rngDoc = Nothing
    Set RegExp = Nothing
    Set allMatches = Nothing
    
End Sub

@Allan:你应该使用YourVariable.SetRange,这样你就可以根据字符位置定义一个范围。
这个方法应该有效:
Sub DollarHighlighter3()
Set regExp = New regExp
Dim objMatch As Match
Dim colMatches As MatchCollection
Dim offsetEnd As Long
Dim rngFormat As Range
Dim intA, intB As Integer
regExp.Pattern = "\$([\,\d{1,3}]*(?:\.\d{2})?)"
regExp.Global = True
Set allMatches = regExp.Execute(ActiveDocument.Content)   ' Execute search.
For i = allMatches.Count - 1 To 0 Step -1
    intA = allMatches.Item(i).FirstIndex
    intB = intA + allMatches.Item(i).Length
    Set rngFormat = ActiveDocument.Range
    rngFormat.SetRange Start:=ActiveDocument.Range.Characters(intA).End, _
        End:=ActiveDocument.Range.Characters(intB).End
    rngFormat.FormattedText.HighlightColorIndex = wdYellow
Next
End Sub

昨天(20.07.2023),我面临着同样的问题:根据正则表达式模式识别文本出现次数,并将其转换为超链接。
对我有效的方法是:逆向解决!
一旦正则表达式对象被"设置",它就具有基于原始单词文本的静态索引值。通过插入超链接,单词文本变得更长。因此,要么在每个文本操作之后重新定义正则表达式对象(问题是:如果插入的超链接本身会匹配到一个结果...),要么从末尾开始逐步解析文档。这可以通过倒计时循环来实现,从最后一个正则表达式出现开始。

美丽。我不得不清空该域的内容,所以这里有一个新的示例文件http://www.smithany.com/exampleDollarHighliter.docx,但是我还没有找到如何在没有类似问题的情况下进行反向操作的方法。我会编辑并尝试一下。 - Allan
1
"start:="的值为"allMatches.Item(i).FirstIndex"。"end:="的值为"start + allMatches.Item(i).Length"。您可以在“本地”视图窗格中比较准确性。由于未知原因,您的"activedocument.range"表现出奇怪的行为。我建议您首先"SET"您的工作范围,然后重新格式化它。 - tobias
再次感谢,非常好的解决方案,但我注意到表格会因为列数而影响字符计数。无论如何,我仍在进行实验,Table.Range.Select似乎显示出正确的字符位置。我认为在现实世界的文档中,这并不那么直接简单。这很遗憾,因为对于快速文档审查来说,这是一个真正'好用'的功能。 - Allan
1
解析您的文档按段落。我更新了我的代码示例。 - tobias

网页内容由stack overflow 提供, 点击上面的
可以查看英文原文,
原文链接