删除除起点和终点之间的单词之外的所有内容

我碰巧在尝试根据自己的喜好操作以下代码时遇到问题。首先，下面的代码删除了我在程序中规定的开始和结束条件之间的所有内容。

我想改变这一点，删除除了开头和结尾词之间规定的所有内容。

Sub SomeSub()
    Dim StartWord As String, EndWord As String
    Dim Find1stRange As Range, FindEndRange As Range
    Dim DelRange As Range, DelStartRange As Range, DelEndRange As Range
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    'Setting up the Ranges
    Set Find1stRange = ActiveDocument.Range
    Set FindEndRange = ActiveDocument.Range
    Set DelRange = ActiveDocument.Range
    'Set your Start and End Find words here to cleanup the script
    StartWord = "From: Research.TA@traditionanalytics.com|Tradition Analytics Commentary| | |"
    EndWord = "This message has been scanned for malware by Websense. www.websense.com"
    'Starting the Find First Word
    With Find1stRange.Find
        .Text = StartWord
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindAsk
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
        'Execute the Find
        Do While .Execute
            'If Found then do extra script
            If .Found = True Then
                'Setting the Found range to the DelStartRange
                Set DelStartRange = Find1stRange
                'Having these Selections during testing is benificial to test your script
                DelStartRange.Select
                'Setting the FindEndRange up for the remainder of the document form the end of the StartWord
                FindEndRange.Start = DelStartRange.End
                FindEndRange.End = ActiveDocument.Content.End
                'Having these Selections during testing is benificial to test your script
                FindEndRange.Select
                'Setting the Find to look for the End Word
                With FindEndRange.Find
                    .Text = EndWord
                    .Execute
                    'If Found then do extra script
                    If .Found = True Then
                        'Setting the Found range to the DelEndRange
                        Set DelEndRange = FindEndRange
                        'Having these Selections during testing is benificial to test your script
                        DelEndRange.Select
                    End If
                End With
                'Selecting the delete range
                DelRange.Start = DelStartRange.Start
                DelRange.End = DelEndRange.End
                'Having these Selections during testing is benificial to test your script
                DelRange.Select
                'Remove comment to actually delete
                DelRange.Delete
            End If      'Ending the If Find1stRange .Found = True
        Loop        'Ending the Do While .Execute Loop 
    End With    'Ending the Find1stRange.Find With Statement
End Sub

哈！这是一个新的转折当然不止一种方法可以做到这一点;我倾向于使用（至少）三个范围。像这样：

Sub FindAndDeleteEverythingElse()
  Dim strFind1 As String, strFind2 As String
  Dim rngDoc As word.Range, rngFind1 As word.Range
  Dim rngFind2 As word.Range
  Dim bFound As Boolean
  strFind1 = "You"
  strFind2 = "directly."
  Set rngDoc = ActiveDocument.content
  Set rngFind1 = rngDoc.Duplicate
  Set rngFind2 = rngDoc.Duplicate
  With rngFind1.Find
    .Text = strFind1
    bFound = .Execute
  End With
  If bFound Then
    With rngFind2.Find
        .Text = strFind2
        bFound = .Execute
    End With
    If bFound Then
        rngDoc.End = rngFind1.Start
        rngDoc.Delete
        rngDoc.Start = rngFind2.End
        rngDoc.End = ActiveDocument.content.End
        rngDoc.Delete
    End If
  End If
End Sub

"主要"范围是整个文档的范围：ActiveDocument.Content 。Range 对象与其他对象略有不同，如果将一个 Range 设置为另一个 Range，则它将成为该 Range，而不是副本。因此，您需要Duplicate方法来复制范围。这使您可以为各种范围独立使用Find。

如果第一个查找成功，则执行第二个查找。如果这也成功，则文档范围的终点将设置为成功查找的起点，并删除范围的内容。然后重新定义文档范围，使其从找到的第二个范围的终点开始，到文档末尾结束，并删除。

您可能需要设置比我在此代码片段中设置更多的 Range.Find 属性 - 我使用了绝对最小值以使使用范围更清晰。

也许还有另一种方法，但在那之前你可以这样做。尝试像这样在字符串之后和之前添加虚拟字符

With ActiveDocument.Range
    With .Find
      .ClearFormatting
      .Replacement.ClearFormatting
      .Forward = True
      .Wrap = wdFindContinue
      .Format = False
      .MatchWildcards = False
      .Text = "From: Research.TA@traditionanalytics.com|Tradition Analytics Commentary| | |"
      .Replacement.Text = "From: Research.TA@traditionanalytics.com|Tradition Analytics Commentary| | |######"
      .Execute Replace:=wdReplaceAll
      .Text = "This message has been scanned for malware by Websense. www.websense.com"
      .Replacement.Text = "@@@@@@This message has been scanned for malware by Websense. www.websense.com"
      .Execute Replace:=wdReplaceAll
    End With
End With
End Sub

然后尝试在 ### 和 @@@@@

@@ 之间设置范围

这是设置范围的最佳答案从一个Word文档中选择一个文本范围并复制到另一个Word文档中

请注意，在我的单词2007中，无法在超链接中找到。在进行替换之前，请尝试删除所有超链接或在范围内。另一个最佳答案：如何从Microsoft Word文档中删除超链接？

相关内容

最新更新

热门标签：