删除突出显示的空格答案

【问题标题】：Remove Highlighted white-spaces删除突出显示的空格
【发布时间】：2021-01-22 06:20:15
【问题描述】：

我正在尝试通过宏从 Word 文本中删除突出显示的空白字符，但只要遇到一些 cmets 或 URL（不是全部），它就会挂起/循环。这怎么可能？解决方案是什么？

Sub checkforHighlightsOrg()

    Application.ScreenUpdating = False
    Dim regex As Object
    Set regex = CreateObject("VBScript.RegExp")
    regex.Global = True
    regex.IgnoreCase = True
    regex.Pattern = "^\s+$" ' highlighted text having multiple white-space/invisible chars only
    
    Selection.Find.ClearFormatting
    Selection.Find.Highlight = True
    With Selection.Find
        .text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchKashida = False
        .MatchDiacritics = False
        .MatchAlefHamza = False
        .MatchControl = False
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
        .MatchFuzzy = False
        .Replacement.Highlight = True
        .Replacement.ClearFormatting
    End With
    
    Dim bReplaced As Boolean
    bReplaced = False
    
    Do While Selection.Find.Execute = True
        If Selection.Find.Found Then
             If regex.Test(Selection.text) Then
                bReplaced = True
                Selection.text = regex.Replace(Selection.text, "")
             End If
        End If
        DoEvents
    Loop
    
    If bReplaced Then MsgBox "Highlighted white-spaces have been removed."
    
    Set rngTemp = ActiveDocument.Range

    With rngTemp.Find
        .ClearFormatting
        .Highlight = True
        .Forward = True
        .Execute
    End With
    If rngTemp.Find.Found = True Then
        MsgBox ("There have been non-white-space highlights found.")
    End If
    
    Application.ScreenUpdating = True

End Sub

我试过的另一个版本如下：

Sub checkforHighlightsV2()

    Application.ScreenUpdating = False
    Dim regex As Object
    Set regex = CreateObject("VBScript.RegExp")
    regex.Global = True
    regex.IgnoreCase = True
    regex.Pattern = "\s+" ' highlighted text having multiple white-space/invisible chars only
    ActiveDocument.Select
      
    
    Dim regex2 As Object, str As String
    Set regex2 = CreateObject("VBScript.RegExp")
     
    With regex2
      .Pattern = "\s"
      .Global = True 'If False, would replace only first
    End With

    
    
    Selection.Find.ClearFormatting
    Selection.Find.Highlight = True
    With Selection.Find
        .text = ""
        .Forward = True
        .Wrap = wdFindStop
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchKashida = False
        .MatchDiacritics = False
        .MatchAlefHamza = False
        .MatchControl = False
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
        .MatchFuzzy = False
        .Replacement.Highlight = True
        .Replacement.ClearFormatting
    End With
    
    Dim bReplaced As Boolean
    bReplaced = False
    Dim a As Range

    
    
    
restart:
    
    Do While Selection.Find.Execute = True
        If Selection.Find.Found Then
    'Selection.MoveEnd wdParagraph, 1
    
     
    Set a = Selection.Range.Duplicate
    'Debug.Print Asc(a.text)
    
    'a.MoveEnd wdCharacter, -1
    
    Dim res As String
     
    If regex.Replace(Replace(a.text, Chr(160), ""), "") = "" Then
    Debug.Print "empty"
    Selection.Delete
    End If
     
'    If a.text = vbCr Or a.text = vbLf Or a.text = vbCrLf Or a.text = vbNewLine Or a.text = vbTab Then
'   ' Debug.Print "newline"
'       bReplaced = True
'                Selection.Delete
'                GoTo restart
'
'    End If
'    If a.text = " " Then Selection.Delete
'
''
''             If regex.Test(a.text) Then
''                bReplaced = True
''                'a.text = regex.Replace(a.text, "")
''                Selection.Delete
''
''             End If
        End If
        DoEvents
    Loop
    
    If bReplaced Then MsgBox "Highlighted white-spaces have been removed."
    
    Set rngTemp = ActiveDocument.Range

    With rngTemp.Find
        .ClearFormatting
        .Highlight = True
        .Forward = True
        .Execute
    End With
    If rngTemp.Find.Found = True Then
        MsgBox ("There have been non-white-space highlights found, this usually means default text.")
    End If
    
    Application.ScreenUpdating = True

End Sub

我最初认为我不应该在搜索选择处于活动状态时替换文本，所以我尝试通过创建版本 2 并调用 selection.delete 来修复它，但不知何故它也不起作用。

正常的搜索对话框不会永远循环，但不允许出现空白字符。感谢您的帮助。

编辑：我也尝试了这个（仅删除突出显示；不删除空格，当我按 Enter 插入文本时突出显示换行符/新段落时 - 这表明标记/突出显示在换行符/段落字符上处于活动状态 - 我尝试了一些变体，例如 ^w^p 但当我想使用 OR 运算符时，我不能将它与“使用通配符”选项结合使用）

Sub Macro6()
'
' Macro6 Macro
'
'
    Selection.Find.ClearFormatting
    Selection.Find.Highlight = True
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Highlight = False
    With Selection.Find
        .Text = "^w"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchKashida = False
        .MatchDiacritics = False
        .MatchAlefHamza = False
        .MatchControl = False
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
        .MatchFuzzy = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
End Sub

最新版本：

Sub RemoveHighlightedWhiteSpace()
   Application.ScreenUpdating = False
   With ActiveDocument.Content.Find
      .ClearFormatting
      .Replacement.ClearFormatting
      .Highlight = True
      .Replacement.Highlight = False
      .text = "[ ,^9,^11,^12,^13," & Chr(160) & "," & Chr(164) & "]{2,}"
      .Forward = True
      .Wrap = wdFindContinue
      .Format = True
      .MatchWildcards = True
      .Execute Replace:=wdReplaceAll
   End With
   Application.ScreenUpdating = True
End Sub

【问题讨论】：

您是否尝试过在 Word 中使用 ^w 作为查找文本进行高级查找？
是的，我试过了，我用这个结果编辑了帖子。
^w 将找到制表符、空格、不间断空格和 1/4 em 空格。将替换文本留空将删除这些字符，而不仅仅是删除突出显示。具体来说，您希望替换哪些字符？
它删除了突出显示，但是当我将鼠标/光标水平指向页面中间时（在左侧，它以前是黄色突出显示的）它停留在那里闪烁，这表明空替换确实没有发生？
它在 O365 中为我工作。具体来说，您希望替换哪些字符？

标签： vba loops replace ms-word selection

【解决方案1】：

试试下面的代码。我找不到包含的唯一字符是 vbLf。

要删除突出显示，您需要使用Format = True，但这不会删除字符，因此必须单独运行。

Sub DeleteHighlightedWhiteSpace()
   'finds at least any 2 of vbTab, vbVerticalTab, vbFormFeed, vbCr, non-breaking space
   Application.ScreenUpdating = False
   With ActiveDocument.Content.Find
      .ClearFormatting
      .Replacement.ClearFormatting
      .Highlight = True
      .text = "[ ,^9,^11,^12,^13," & Chr(160) & "]{2,}"
      .Replacement.text = ""
      .Forward = True
      .Wrap = wdFindContinue
      .Format = False
      .MatchWildcards = True
      .Execute Replace:=wdReplaceAll
   End With
   Application.ScreenUpdating = True
End Sub

Sub RemoveHighlighting()
   Application.ScreenUpdating = False
   With ActiveDocument.Content.Find
      .ClearFormatting
      .Replacement.ClearFormatting
      .Highlight = True
      .Replacement.Highlight = False
      .Forward = True
      .Wrap = wdFindContinue
      .Format = True
      .Execute Replace:=wdReplaceAll
   End With
   Application.ScreenUpdating = True
End Sub

编辑：您要达到的目标仍不清楚。从您的 cmets 看来，您似乎正试图从整个文档中删除所有突出显示。如果是这样，那么有一个简单的方法可以做到这一点：

Sub RemoveAllHighlighting()
   Dim story As Range
   For Each story In ActiveDocument.StoryRanges
      story.HighlightColorIndex = wdNoHighlight
   Next story
End Sub

【讨论】：

谢谢。我得出的结论是，删除那些突出显示的空白不是很有用（确实会弄乱布局）。我稍微改变了你的版本（见主帖）。它仍然没有从表格单元格中删除不可见的突出显示（我使用 ^7 和 chr(164) 作为“单元格结束”标记，显然不允许第一个）。我的目的是清除几乎现在可以使用的空白的所有亮点，除了单元格中的那些。之后，我需要找到非空白亮点。但是 [!^w] 不起作用。
@Mat90 - 目前还不清楚您的确切目标是什么。如果您在问题之前/之后显示的屏幕截图中包含这会更好。
@Mat90 - 如果您只想清除文档中的所有突出显示，那么这正是我回答中的 RemoveHighlighting 例程所做的。
是的，在您替换子之后，它可以工作，除了“空”单元格（当我搜索突出显示时，它会在单元格中找到那些）
感谢您的帮助。目标是消除隐形字符上的所有亮点。因此，当按回车键时，我不会从高亮显示开始输入。之后，我需要提醒（消息框）审阅者有一些突出显示的文本（在此之前我应该清除所有误报突出显示，即不可见的突出显示，以便只保留需要注意的有效内容）。最初，我想我会执行一些不可见的字符清理（突出显示），比如双突出显示的空格，但这不再是我的重点，因为它可能会弄乱布局。