如何刪除開始和結束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