Блог

Главная - Вопросы по программированию - Я хочу выделить слово, если за ним не следует другое конкретное слово, используя VB

Я хочу выделить слово, если за ним не следует другое конкретное слово, используя VB

#vba #ms-office #word

#vba #ms-office #word

Вопрос:

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

     Sub fek()
'
' 
'
'
 Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "n."
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = True
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute

    If Selection.Find.Found = True Then
        With Selection.Range
        
        .MoveStart wdWord, 2
        
        End With
        
        With Selection.Find
        .Text = "fek"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = True
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
                    End With
                    
                    End If
                    
        If Selection.Find.Found = False Then
        Selection.Range.HighlightColorIndex = wdYellow
            End If
End Sub

Ответ №1:

Приведенный ниже код должен делать то, что вы хотите. Вы должны иметь в виду, что то, что Word определяет как a Word , может отличаться от того, что сделал бы человек, например, IP-адрес считается как 7 слов!

 Sub fek()
   Dim findRange As Range
   Dim nextWords As Range
   
   Set findRange = ActiveDocument.Content
   With findRange.Find
      .ClearFormatting
      .Text = "n."
      .Forward = True
      .Wrap = wdFindStop
      .Format = False
      .MatchCase = True
      .MatchWholeWord = False
      .MatchWildcards = False
      .MatchSoundsLike = False
      .MatchAllWordForms = False
   
      Do While .Execute = True
         'findRange is now the range of the match so set nextWords to the 2 next words
         Set nextWords = findRange.Next(wdWord)
         nextWords.MoveEnd wdWord, 3
         'look for the specific text in the next two words
         If InStr(nextWords.Text, "fek") = 0 Then findRange.HighlightColorIndex = wdYellow
         'collapse and move findRange to the end of the match
         findRange.Collapse wdCollapseEnd
         findRange.Move wdWord, 4
      Loop
   End With
End Sub

Комментарии:

1. Просто измените nextWords.MoveEnd wdWord на nextWords.MoveEnd wdWord, 3

2. Спасибо за ваш ответ. Код, казалось, работал изначально, но, похоже, он выделяет слово независимо от того, находится ли рядом слово fek. Я расширил диапазон, основываясь на том, что вы сказали о том, как word подсчитывает слова, но, похоже, это не имеет никакого значения. Я использую это на греческом языке — я не знаю, может ли это быть проблемой, но оно отлично работает с другими частями кода.

3. Пожалуйста, смотрите отредактированный ответ. Сначала я неправильно понял, что вы хотели, и когда я понял, что вы хотите выделить начальное слово, только если следующего слова не было, я быстро изменил логику, забыв, что InStr тогда это не будет равно True / False . Код в моем ответе работает в моем тестировании, хотя я не тестирую его на греческом тексте.

4. Это отлично работает и на греческом языке тоже. Я действительно благодарен!

Ответ №2:

Следующее, вероятно, будет значительно быстрее, если в документе много строк «n».:

 Sub Demo()
Application.ScreenUpdating = False
Dim i As Long
i = Options.DefaultHighlightColorIndex
Options.DefaultHighlightColorIndex = wdYellow
With ActiveDocument.Range
  With .Find
    .Forward = True
    .Format = False
    .MatchCase = False
    .Wrap = wdFindContinue
    .MatchWildcards = True
    .ClearFormatting
    .Replacement.ClearFormatting
    .Replacement.Highlight = True
    .Text = "n."
    .Replacement.Text = "^amp;"
    .Execute Replace:=wdReplaceAll
    .Replacement.Highlight = False
    .Text = "n.[^s ]@fek"
    .Execute Replace:=wdReplaceAll
    .Text = "n.[^s ]@[!^s ]@fek"
    .Execute Replace:=wdReplaceAll
    .Text = "n.[^s ]<[!^s ]@>[^s ]@fek"
    .Execute Replace:=wdReplaceAll
    .Text = "n.[^s ]<[!^s ]@>[^s ]@[!^s ]@fek"
    .Execute Replace:=wdReplaceAll
  End With
End With
Options.DefaultHighlightColorIndex = i
Application.ScreenUpdating = True
End Sub