Question

我有一段VBA代码，它使用Find查找文档中的所有首字母缩写词。为此，它使用...搜索所有由2个或多个字符组成的大写字母的单词。

<[A-Z]{2,}>

此问题是它没有吸收所有缩写，例如CoP，W3C，DVD和CD-ROM。它在两个部分中选择了带连字符的首字母缩写词，这是不理想的，但由于用户检查了列表，因此可以接受。我也可以通过不使用...来搜索以“ s”或其他字符结尾的单词的末尾。

<[A-Z]{2,}

但这不会将任何非大写字符都计入它发现的单词中。

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

Answer 1

除了结合宏代码外，我认为不可能“在任何位置搜索带有两个或更多个大写字母的单词并找到整个单词”。既然您使用的是宏，那么以下示例文本对我来说是一种有效的方法

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

和此通配符组合（请注意，在Windows配置中，列表分隔符为;，对于其他区域，可能需要,。）

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

以下函数检查“找到”范围内的第二个字母或以后的字母是否大写，并将布尔值返回给调用过程。它遍历给定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

您无法通过一次查找/替换来执行此操作。您还必须对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

在单词/ VBA中查找包含多个大写字母的单词

3 个答案: