如何删除开始和结束VBA单词之间的文本

Question

如何删除开始词和结束词之间的文本。

我有大约一百万个单词的大量文本摘录，我想创建一个VBA脚本，该脚本将删除所有不需要的文本。

幸运的是，我有关键词可以查找并删除这些关键词之后的所有文本，直到我想要输入的特定端点。

我需要一个程序，这些程序可以找到这些关键字并将其分别用作起始词，然后将结束词专用于结束位置，并删除它们之间的所有文本。 如果该词位于一个段落中，我想删除该段落。

下面的程序可以完成我所要查找的所有内容，但是它无法循环遍历文档，并且无法将其发送到具有相同起始和结束位置的其他消息。

Sub SelectRangeBetween()


Selection.HomeKey Unit:=wdStory
'Selection.TypeText Text:="hello"

 ' The Real script
Dim myrange As Range
Selection.HomeKey wdStory
Selection.Find.ClearFormatting
With Selection.Find
    .Execute findtext:="From: Research.TA@traditionanalytics.com", Forward:=True, Wrap:=wdFindStop 'this will initiate the start word
    Set myrange = Selection.Range
    myrange.End = ActiveDocument.Range.End
    myrange.Start = myrange.Start
    myrange.End = myrange.End + InStr(myrange, "This message has been scanned ") ' this will initiate the end word
    myrange.Select

    'Selection.Delete
End With
End Sub

Answer 1

下面的脚本将搜索您的两个关键字，并选择从第一个关键字的开头到第二个关键字的结尾的范围。 只需删除'即可删除范围。

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

'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"
EndWord = "This message has been scanned "

'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

要选择关键字所在的Paragraph ，请参见以下内容：

Sub SomeOtherSub()

Dim StartWord As String, EndWord As String
Dim Find1stRange As Range, ParagraphRange As Range

'Setting up the Ranges
Set Find1stRange = ActiveDocument.Range
Set ParagraphRange = ActiveDocument.Range


'Set your Start and End Find words here to cleanup the script
StartWord = "From: Research.TA@traditionanalytics.com"
EndWord = "This message has been scanned "

'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

            'Having these Selections during testing is benificial to test your script
            'Find1stRange.Select

            'Setting the Paragraph range
            Set ParagraphRange = Find1stRange.Paragraphs(1).Range

            'Having these Selections during testing is benificial to test your script
            ParagraphRange.Select

            'Deleting the paragraph
            'FoundParagraph.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