如何根据关键字筛选出相应的句子

mmcha2002

想通过宏的方式，直接将所有含有“风”字的诗句，以句号的形式显示出来。如下图所示。

宏的代码最好是方便修改，因为还想能过这个代码将含有“春”“雨”……等关键字的诗句以句号为标志显示出来。

只以句号、问号、感叹号、省略号为标志，如“明月何时照我还？”那一句，是以问号结束的。不要整个段落都显示。但“忽如一夜春风来，千树万树梨花开。桃花一簇开无主，可爱深红爱浅红。”这一句，只显示“忽如一夜春风来，千树万树梨花开。”而“桃花一簇开无主，可爱深红爱浅红。”则不显示。

mmcha2002

如果能不用代码，有其他的方法也可以

mmcha2002

比如在 查找  对话框里面如果有办法就最好了

duquancai

mmcha2002 发表于 2018-4-5 22:03
如果能不用代码，有其他的方法也可以

Sub TEST()
    Dim d As Document, k()
    k = Array("风", "春") '自己添加关键词
    Set d = ActiveDocument
    With d.Content
        .Font.ColorIndex = wdAuto
        .HighlightColorIndex = wdNoHighlight
    End With
    For i = 0 To UBound(k)
        With d.Content.Find
            Do While .Execute(k(i))
                With .Parent
                    .Expand wdSentence
                    .HighlightColorIndex = wdYellow
                    .Start = .End
                End With
            Loop
        End With
    Next
End Sub

duquancai

看你表达很清楚，也有附件，另外：“只以句号、问号、感叹号、省略号为标志” 这个正好是 MSoffice默认的 “句子对象”！
所以：我写代码了！

mmcha2002

duquancai 发表于 2018-4-5 22:43
看你表达很清楚，也有附件，另外：“只以句号、问号、感叹号、省略号为标志” 这个正好是 MSoffice默认的  ...

Sub test1()
    Dim findtext As String, n As Integer, info As String
    findtext = InputBox("请输入要查的单词", , "Number")
    If findtext <> "" Then
        With ActiveDocument.Content.Find
            .Text = findtext
            .MatchAllWordForms = True
            Do While .Execute
                n = n + 1
                With .Parent
                    .Expand wdSentence
                    If .Text Like "*" & Chr(13) Then .End = .End - 1
                    info = info & n & vbTab & .Text & Chr(13)
                    .Collapse wdCollapseEnd
                End With
            Loop
        End With
        With Documents.Add.Content
            .Text = info
        End With
    End If
End Sub

谢谢您！！！

您好，之前见到过这样一个代码，运行代码后，会出现一个对话框，只要在里面直接输入所需要查找的文字即可。只是我不需要像这样另外建一个文档，只要在原有文件里面显示相关的含有某个关键字的相关句子即可。不知道您给出的代码能不能也像这个一样，单独出现一个对话框，这样以后我只要在对话框里面输入所要查找的字就行。再次谢谢您

mmcha2002

duquancai 发表于 2018-4-5 22:43
看你表达很清楚，也有附件，另外：“只以句号、问号、感叹号、省略号为标志” 这个正好是 MSoffice默认的  ...

谢谢您，辛苦您了！！

Sub test1()

    Dim findtext As String, n AsInteger, info As String

    findtext = InputBox("请输入要查的单词",, "Number")

    If findtext <>"" Then

        WithActiveDocument.Content.Find

           .Text = findtext

           .MatchAllWordForms = True

           Do While .Execute

               n = n + 1

               With .Parent

                   .Expand wdSentence

                   If .Text Like"*" & Chr(13) Then .End = .End - 1

                   info = info & n& vbTab & .Text & Chr(13)

                   .CollapsewdCollapseEnd

               End With

           Loop

        EndWith

        WithDocuments.Add.Content

           .Text = info

        EndWith

    End If

End Sub

这是我之前见到过的一个代码，运行宏的时候，会单独出现一个对话框，如图所示。只是我不需要像这个代码一样重新建一个文档。所以，想请问您，不知道您的代码能不能也像这样出现一个对话框，这样，我就可以直接在对话框里面输入相应的文字，这样查找起来会更方便一些。

duquancai

mmcha2002 发表于 2018-4-6 12:25
谢谢您，辛苦您了！！

Sub test1()    Dim findtext As String, n AsInteger, info As String    find ...

Sub test()
    Dim findtext As String, d As Document
    findtext = InputBox("请输入要查的单词", , "风")
    If findtext = Empty Then Exit Sub
    Set d = ActiveDocument
    With d.Content
        .Font.ColorIndex = wdAuto
        .HighlightColorIndex = wdNoHighlight
    End With
    With d.Content.Find
        Do While .Execute(findtext)
            With .Parent
                .Expand wdSentence
                .HighlightColorIndex = wdYellow
                .Start = .End
            End With
        Loop
    End With
End Sub

mmcha2002

duquancai 发表于 2018-4-6 14:31
Sub test()
    Dim findtext As String, d As Document
    findtext = InputBox("请输入要查的单词", ...

非常感谢您

mmcha2002

duquancai 发表于 2018-4-6 14:31
Sub test()
    Dim findtext As String, d As Document
    findtext = InputBox("请输入要查的单词", ...

谢谢您。感谢您一直回复我的信息。您的代码太实用了。只是，突然还有个小小的请求。比如说，我想找到一个句子中同时含有“风”“雨”，或者同时含有三个或三个以上的字的句子，如同时含有“风”“雨”“云”等等，或者同时含有“风”“雨”“云”“风”等等。在这种情况下，如何修改一下代码，使得在弹出的对话框中，直接输入所有要查找的关键字即可呢？
不知道这个想法，是不是有点不太实际……