我想突出显示一个单词,如果它后面没有使用 VB 另一个特定单词
I want to highlight a word if it is not followed by another specific word using VB
所以在使用 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
下面的代码应该可以满足您的需求。您需要记住,Word 定义为 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
如果文档中有很多 '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 = "^&"
.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
所以在使用 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
下面的代码应该可以满足您的需求。您需要记住,Word 定义为 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
如果文档中有很多 '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 = "^&"
.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