如何修改代码，不显示没有句末标点符号的句子

mmcha2002

文后有一个宏代码，可以查找出一篇文档中是否含有某些关键字的句子并突出显示。如根据“风”“雨”“花”等多个关键字（关键字可以是一个，也可以是多个）同时查找相关的句子。但现在想请教的是，如果某个句子没有句后的标点符号如“。！？……”等，能不能即使有相应的关键字，但也不显示呢。

如第一句“参横斗转欲三更，苦雨终风也解晴”这句话虽然有“风”也有“雨”字，但因为没有句号，所以在运行代码的时候，就不需要突出显示。而其他的含有“。！？……”等带有句末标点的句子，正常突出显示。

请问如何修改以下的代码？

参横斗转欲三更，苦雨终风也解晴

草铺横野六七里，笛弄晚风三四声。

传语风光共流转，暂时相赏莫相违。

垂死病中惊坐起，暗风吹雨入寒窗。

垂杨只解惹春风，何曾系得行人住。

春风得意马蹄疾，一日看尽长安花。

春风桃李花开日，秋雨梧桐叶落时。

春风又绿江南岸，明月何时照我还？

风一更，雪一更，聒碎乡心梦不成，故园无此声。

风雨送春归，飞雪迎春到。

风雨晚来初定。

风乍起，吹皱一池春水。

风住尘香花已尽，日晚倦梳头。

怪生无雨都张伞，不是遮头是使风。

还似旧时游上苑，车如流水马如龙，花月正春风。

黄师塔前江水东，春光懒困倚微风。

回首向来萧瑟处，归去，也无风雨也无晴。

duquancai

“没有句末标点符号的” 这还算是一句话吗？什么逻辑？

mmcha2002

duquancai 发表于 2018-4-12 11:38
“没有句末标点符号的” 这还算是一句话吗？什么逻辑？

嗯，我的想法是把古诗词里面含有相关的关键字的诗句整理在一起这样方便记忆。由于有些诗词的题目里面也含有关键字，因此也会被突出显示。

如陆游的诗《十一月四日风雨大作》这首诗的题目里就有“风”“雨”二字。但当我使用“风”“雨”进行查找的时候，这个题目“十一月四日风雨大作”也会被突出显示，而我并不想显示这些题目。

不知道，您能明白我的意思不？

ming0018

mmcha2002 发表于 2018-4-12 14:51
嗯，我的想法是把古诗词里面含有相关的关键字的诗句整理在一起这样方便记忆。由于有些诗词的题目里面也含 ...

我明白了，我帮你写伪代码：
查找“风”and“雨”
如果查找到的句子代有书名号，就排除。
不知道你懂了没？

duquancai

mmcha2002 发表于 2018-4-12 14:51
嗯，我的想法是把古诗词里面含有相关的关键字的诗句整理在一起这样方便记忆。由于有些诗词的题目里面也含 ...

意思我早就明白！只是不想写！看到你这么纠结，我还是写一个代码给你吧！请测试：

1. Sub test()
   
2.     代码更正及精简 在后面。。。。
   
3. End Function

复制代码

mmcha2002

duquancai 发表于 2018-4-12 20:07
意思我早就明白！只是不想写！看到你这么纠结，我还是写一个代码给你吧！请测试：

真是太感谢您了。测试成功！！！

duquancai

mmcha2002 发表于 2018-4-13 12:23
真是太感谢您了。测试成功！！！

代码精简了一下，请测试如下代码吧！！！

1. Sub test()
   
2.     Dim findtext As String, n As Integer, k, x As Long
   
3.     findtext = InputBox("关键词" & vbCr & "多关键词格式：风,万" & vbCr & "一个关键词格式：风", , "刀,风")
   
4.     ActiveDocument.Content.HighlightColorIndex = wdNoHighlight
   
5.     If findtext = Empty Then Exit Sub
   
6.     k = Split(findtext, ","): n = UBound(k)
   
7.     With ActiveDocument.Content.Find
   
8.         Do While .Execute(k(n))
   
9.             With .Parent
   
10.                 .Expand wdSentence
    
11.                 .MoveEndWhile vbCr, wdBackward
    
12.                 If f(k, .Text, n) And .Text Like "*[。！？……]" Then
    
13.                     .HighlightColorIndex = wdYellow
    
14.                     x = x + 1
    
15.                 End If
    
16.                 .Start = .End
    
17.             End With
    
18.         Loop
    
19.     End With
    
20.     MsgBox IIf(x > 0, "找到：" & x & "条句子并标记！", "没有找到符合要求的！")
    
21. End Sub
    
22. Function f(k, ByVal sr As String, ByVal n As Integer) As Boolean
    
23.     Dim x As Integer
    
24.     If n = 0 Then f = True: Exit Function
    
25.     Do While x <= n - 1
    
26.         If InStr(sr, k(x)) = 0 Then Exit Do
    
27.         x = x + 1
    
28.     Loop
    
29.     If x = n Then f = True
    
30. End Function

复制代码

mmcha2002

duquancai 发表于 2018-4-13 13:48
代码精简了一下，请测试如下代码吧！！！

谢谢您，下次一定记得注出处。

还想请问一下，代码的这部分是不是可以删除的？因为把您给的两个代码同时放在宏里面后，在运行其中一个的时候，会提示“出现二义性的名称”，一定要删除其中一个，不知道删除之后，会不会影响到运行代码的结果？

Function f(k, ByVal sr As String, ByVal n As Integer) As Boolean
    Dim x As Integer
    If n = 0 Then f = True: Exit Function
    Do While x <= n - 1
        If InStr(sr, k(x)) = 0 Then Exit Do
        x = x + 1
    Loop
    If x = n Then f = True
End Function

mmcha2002

duquancai 发表于 2018-4-13 13:48
代码精简了一下，请测试如下代码吧！！！

谢谢您，下次一定记得注出处。

还想请问一下，代码的这部分是不是可以删除的？因为把您给的两个代码同时放在宏里面后，在运行其中一个的时候，会提示“出现二义性的名称”，一定要删除其中一个，不知道删除之后，会不会影响到运行代码的结果？

Function f(k, ByVal sr As String, ByVal n As Integer) As Boolean
    Dim x As Integer
    If n = 0 Then f = True: Exit Function
    Do While x <= n - 1
        If InStr(sr, k(x)) = 0 Then Exit Do
        x = x + 1
    Loop
    If x = n Then f = True
End Function

mmcha2002

duquancai 发表于 2018-4-13 13:48
代码精简了一下，请测试如下代码吧！！！

谢谢您，下次一定记得注出处。

还想请问一下，代码的这部分是不是可以删除的？因为把您给的两个代码同时放在宏里面后，在运行其中一个的时候，会提示“出现二义性的名称”，一定要删除其中一个，不知道删除之后，会不会影响到运行代码的结果？

Function f(k, ByVal sr As String, ByVal n As Integer) As Boolean
    Dim x As Integer
    If n = 0 Then f = True: Exit Function
    Do While x <= n - 1
        If InStr(sr, k(x)) = 0 Then Exit Do
        x = x + 1
    Loop
    If x = n Then f = True
End Function