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

Question

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

我有大约 100 万字的大量文本提取，我想创建一个 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