Sub 删除查找含关键词的行()

    Dim KeyWord As String

    KeyWord = InputBox("请输入关键词（词长不限，中英均可）：", "关键词设置", "")

    If KeyWord = "" Then Exit Sub

    Selection.HomeKey wdStory

    Do

        With Selection.Find

            .Text = KeyWord

            .Wrap = wdFindStop

            .Forward = True

        End With

        If Selection.Find.Execute = False Then Exit Do

            Selection.Paragraphs().Range.Select

            If (Left(Selection.Text, Len(KeyWord))) = KeyWord Then

            Selection.Paragraphs().Range.delete

            Selection.HomeKey unit:=wdLine

        End If

    Loop

    Selection.HomeKey unit:=wdStory

End Sub

Sub DelBlank()

    Dim i as Paragraph, n as Long

    Application.ScreenUpdating = False

    For Each i In ActiveDocument.Paragraphs

        If Len(i.Range) =  Then

            i.Range.Delete

            n = n +

        End If

    Next

    MsgBox "共删除空白段落" & n & "个。"

    Application.ScreenUpdating = True

End Sub