Найти слова с более чем одной заглавной буквой в слове / VBA

Question

У меня есть фрагмент кода VBA, который использует Найти , чтобы найти все сокращения в документе. Это делается путем поиска всех слов, состоящих из заглавных букв длиной 2 или более символов, с использованием ...

<[A-Z]{2,}>

Проблема в том, что он не улавливает все сокращения, такие как CoP, W3C, DVD и CD-ROM. Он собирает дефисные аббревиатуры из двух частей, которые не идеальны, но допустимы, так как список проверяется пользователем. Я также могу подбирать слова, которые заканчиваются буквой "s" или другими символами, не ища в конце слова, используя ...

<[A-Z]{2,}

Но это не учитывает любой символ не в верхнем регистре как часть слова, которое он находит.

Существует ли выражение, которое позволило бы мне искать слова с двумя или более заглавными буквами в любом месте и находить слово целиком?

Answer 1

Вы не можете сделать это за один проход 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 2

Вы можете использовать что-то вроде:

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

Answer 3

Я не думаю, что можно «искать слова с двумя или более заглавными буквами в любом месте и находить слово целиком», кроме как в сочетании с макросом. Так как вы используете макрос, в любом случае, вот подход, который работал для меня, используя следующий пример текста

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