在 word/VBA 中查找包含一个以上大写字母的单词

Question

我有一段 VBA 代码使用 Find 查找文档中的所有首字母缩略词。它通过搜索所有包含 2 个或更多字符长的大写字母的单词来执行此操作...

<[A-Z]{2,}>

问题是它没有提取所有首字母缩略词，例如 CoP、W3C、DVD 和 CD-ROM。它在两个部分中选择带连字符的首字母缩略词，这并不理想，但在用户检查列表时是允许的。我还可以通过不使用...

搜索到单词的末尾来获取以 "s" 或其他字符结尾的单词

<[A-Z]{2,}

但这不会将任何非大写字符算作它找到的单词的一部分。

是否有一个表达式可以让我在任何位置搜索具有两个或更多大写字母的单词并找到整个单词？

Answer 1

我认为 'search for words with two or more capital letters in any location and find the whole word' 不可能，除非与宏代码结合使用。由于您使用的是宏，所以这里有一种使用以下示例文本对我有用的方法

CoP, this That and AnoTher thing W3C, DVDs and CD-ROM

和这个通配符组合（请注意，我的 Windows 配置中的列表分隔符是 ;，对于其他地区，可能需要 ,）。

<[A-Z][0-9A-Z\-a-z]{1;10}>

以下函数检查 "found" 范围内的第二个或后面的字母是否大写，并且 returns 是否为调用过程的布尔值。它遍历给定 Range 中的字符，检查 ASCII 值。一旦找到一个，循环就会退出。

Function ContainsMoreThanOneUpperCase(rng As Word.Range) As Boolean
    Dim nrChars As Long, i As Long
    Dim char As String
    Dim HasUpperCase

    HasUpperCase = False
    nrChars = rng.Characters.Count
    For i = 2 To nrChars
        char = rng.Characters(i).text
        If Asc(char) >= 65 And Asc(char) <= 90 Then
            'It's an uppercase letter
            HasUpperCase = True
            Exit For
        End If
    Next
    ContainsMoreThanOneUpperCase = HasUpperCase
End Function

使用示例：

Sub FindAcronyms()
    Dim rngFind As Word.Range
    Dim bFound As Boolean

    Set rngFind = ActiveDocument.content
    With rngFind.Find
        .text = "<[A-Z][0-9A-Z\-a-z]{1;10}>"
        .MatchWildcards = True
        .Forward = True
        .wrap = wdFindStop
        bFound = .Execute
        Do While bFound
            If bFound And ContainsMoreThanOneUpperCase(rngFind) Then
                Debug.Print rngFind.text
                rngFind.HighlightColorIndex = wdBrightGreen
            End If
            rngFind.Collapse wdCollapseEnd
            bFound = .Execute
        Loop
    End With
End Sub

Answer 2

你不能在 Find/Replace 的一次通过中完成此操作。您还必须考虑到 Word 应用程序将什么视为 Word，以及首字母缩略词在句子或段落中的位置。

下面的代码应该可以让您了解如何结合使用通配符搜索和其他 VBA 字符串操作来完成此操作。

它被设置为处理以大写字母开头的单词，如果您希望有任何以小写字母开头的单词，您将需要进一步携带它并为以小写字母开头的单词添加代码和通配符搜索条件。

Sub FindAcronynms()
    Dim rng As word.Range
    Set rng = ActiveDocument.Content
    With rng.Find
        .ClearFormatting
        .Format = False
        .Forward = True
        .MatchWildcards = True
        .Text = "<[A-Z]{1,}[a-z][A-Z]>"
        .Wrap = wdFindStop
        .Execute
        Do While .found
            MoveEndOfString rng
            rng.HighlightColorIndex = wdTeal
            rng.Collapse wdCollapseEnd
            .Execute
        Loop
    End With
    Set rng = ActiveDocument.Content
    With rng.Find
        .ClearFormatting
        .Format = False
        .Forward = True
        .MatchWildcards = True
        .Text = "[A-Z]{1,5}[0-9][A-Z]{1,5}"
        .Wrap = wdFindStop
        .Execute
        Do While .found
            MoveEndOfString rng
            rng.HighlightColorIndex = wdTeal
            rng.Collapse wdCollapseEnd
            .Execute
        Loop
    End With
    Set rng = ActiveDocument.Content
    With rng.Find
        .ClearFormatting
        .Format = False
        .Forward = True
        .MatchWildcards = True
        .Text = "<[A-Z]{2,}>"
        .Wrap = wdFindStop
        .Execute
        Do While .found
            MoveEndOfString rng
            rng.HighlightColorIndex = wdTeal
            rng.Collapse wdCollapseEnd
            .Execute
        Loop
    End With
    MsgBox "Action Complete", vbExclamation, "Custom Find"
End Sub
Private Function MoveEndOfString(ByRef rng As word.Range)
    rng.MoveEnd wdCharacter, 1
    Select Case Asc(rng.Characters.Last)
        Case Is <= 32
            rng.MoveEnd wdCharacter, -1
        Case 45
            rng.MoveEnd wdCharacter, 1
            rng.MoveEnd wdWord, 1
            If Asc(rng.Characters.Last) = 32 Then
                'required because move above includes
                'trailing space
                rng.MoveEnd wdCharacter, -1
            End If
    End Select
End Function

Answer 3

您可以使用类似的东西：

Sub Demo()
Application.ScreenUpdating = False
Options.DefaultHighlightColorIndex = wdPink
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Replacement.Highlight = True
    .Forward = True
    .Format = True
    .Wrap = wdFindContinue
    .MatchWildcards = True
    .Text = "<[A-Z][A-Z0-9/-]{1,}"
    .Replacement.Text = "^&"
    .Execute Replace:=wdReplaceAll
    .Text = "<[A-Z][A-Za-z0-9/-]@[A-Z]"
    .Replacement.Text = "^&"
    .Execute Replace:=wdReplaceAll
  End With
End With
Application.ScreenUpdating = True
End Sub

在 word/VBA 中查找包含一个以上大写字母的单词

Find words with more than one capital letter in word/VBA

regex

vba

ms-word

find

acronym