如何在一篇英文中把含有某个单词的句子都列出来？

jiuyuedefeng

另外，原文中有些只是短语，不是句子，行末是没有句号等符号的，如何批量删除？

yyqq16888

全选——复制，EXCEL中选中A2——粘贴——（A1随便打入标题）——数据，筛选，自动筛选——选“包含”，number，确定。
选中结果——复制——WORD中粘贴。

sylun

原帖由 jiuyuedefeng 于 2010-10-12 16:49 发表
谢谢sylun老大的解答。烦请老大把问题二的代码再修改一下，比如单词表里有number，……，那么在原文中只要第一次找到含有number的例句，把这个例句摘出来后，就直接搜索下一个单词。也就是每个单词一个例句。应该是改 ...

可试试：

1. Sub test3()
   
2.     Dim fs, f
   
3.     Dim Dlg As FileDialog, findtext() As String
   
4.     Dim i As Integer, c As Long, info As String
   
5.    
   
6.     Set fs = CreateObject("Scripting.FileSystemObject")
   
7.     Set Dlg = Application.FileDialog(msoFileDialogFilePicker)
   
8.     With Dlg
   
9.         .Title = "请指定单词列表文本文件"
   
10.         .InitialFileName = ActiveDocument.Path
    
11.         .AllowMultiSelect = False
    
12.         If .Show <> -1 Then Exit Sub
    
13.         Set f = fs.OpenTextFile(.SelectedItems(1))
    
14.         findtext() = Split(f.ReadAll, vbCrLf)
    
15.         f.Close
    
16.         Set fs = Nothing
    
17.     End With
    
18.     With ActiveDocument.Content.Find
    
19.         .MatchAllWordForms = True
    
20.         For i = 0 To UBound(findtext)
    
21.             info = info & vbCrLf & findtext(i) & vbCrLf
    
22.             .Text = findtext(i)
    
23.             If .Execute Then
    
24.                 c = c + 1
    
25.                 With .Parent
    
26.                     .Expand wdSentence
    
27.                     If .Text Like "*" & Chr(13) Then .End = .End - 1
    
28.                     info = info & .Text & Chr(13)
    
29.                 End With
    
30.             End If
    
31.             .Parent.WholeStory
    
32.         Next
    
33.     End With
    
34.     info = "共搜索到" & c & "条。" & vbCrLf & info
    
35.     Documents.Add.Content.Text = info
    
36. End Sub

复制代码

另外，原文中有些只是短语，不是句子，行末是没有句号等符号的，如何批量删除？

1. Sub test4()
   
2.     Application.ScreenUpdating = False
   
3.     With ActiveDocument.Content.Find
   
4.         .Text = "[!^13]@[A-Za-z]^13"
   
5.         .MatchWildcards = True
   
6.         .Replacement.Text = ""
   
7.         .Execute Replace:=wdReplaceAll
   
8.     End With
   
9.     Application.ScreenUpdating = True
   
10. End Sub

复制代码

jiuyuedefeng

谢谢老大，程序很好用。但是单词列表里单词一多就会出现如图的错误，是因为单词太多了吗？

另外再询问老大一个问题，比如例句"She was the mainstay of the team."，当用单词列表搜索时，那么 mainstay 词条会显示这个例句，如果team搜索时也是第一条例句就是这个句子，那么team词条也会显示这个例句。这样两个句子就重复了。能不能把两个词归并，只显示一个句子。
mainstay  team
She was the mainstay of the team.
或者针对team找可以搜索到的第二个例句把它列出来肯定就不重复了。
设计这个文档的目的就是给定一个单词表，另给一个例句库，使得选出来最少的句子都包含这个单词表里的单词，这样就可以用最少的句子来记整个单词表。所以需要把重复句子去掉。

jiuyuedefeng

对于“有限的句子涵盖给定的单词表”这个方案提供个思路，老大参考一下看是否可行。
比如单词表里第一个单词是"she"搜索到的句子是"She was the mainstay of the team."，这个句子包含6个单词，那么就在给定的单词表里把这六个单词删掉。然后程序开始搜索单词列表里的第二个单词，假如是"estate",搜索到的例句是"He made over the whole estate to his son."那么就在给定的单词表中删除这个句子包含的单词。这样应该可以保证最少的句子包含全部单词。
我不会编程，也不知道这样是否可行，或者还是照原来的方式更简单些。老大费心了。

jiuyuedefeng

出现运行时错误'5610',似乎是单词列表里有"according to"这样的短语，因为中间有空格。

jiuyuedefeng

如果删除重复句子的代码不好做，老大就不用做了。我用您现在给的代码把句子做好，删掉每个句子前的单词，把句子复制到excel,然后按升序排序，这样就会看到重复的句子了。不过这样的话，老大能不能受累给编一个excel中批量删除相同句子的程序。
另外现有的代码能不能修改一下，可以使其能够搜索单词列表中的短语，比如"according to"，因为中间有空格现在的代码无法通过。

szh9388

7楼的方法很实用，17楼老师的方法是变通，同样好用，谢了

[ 本帖最后由 szh9388 于 2010-10-13 08:44 编辑 ]

sylun

我想单词在句子中还应考虑动词时态、名词复数等变化因素吧？看来楼主的想法还不够成熟。
我对英语并没多少研究，现根据楼主前面的说明对程序再作一次修改，希望能符合楼主的意思，至于其他问题，我无法解决。

1. Sub test5()
   
2.     Dim fs, f
   
3.     Dim findtext() As String, temp As String
   
4.     Dim i As Integer, c As Long, info As String
   
5.    
   
6.     Set fs = CreateObject("Scripting.FileSystemObject")
   
7.     With Application.FileDialog(msoFileDialogFilePicker)
   
8.         .Title = "请指定单词列表文本文件"
   
9.         .InitialFileName = ActiveDocument.Path
   
10.         .AllowMultiSelect = False
    
11.         If .Show <> -1 Then Exit Sub
    
12.         Set f = fs.OpenTextFile(.SelectedItems(1))
    
13.         findtext() = Split(f.ReadAll, vbCrLf)
    
14.         f.Close
    
15.         Set fs = Nothing
    
16.     End With
    
17.     With ActiveDocument.Content.Find
    
18.         For i = 0 To UBound(findtext)
    
19.             .MatchAllWordForms = IIf(findtext(i) Like "*[!A-Za-z]*", False, True)
    
20.             info = info & vbCrLf & findtext(i) & vbCrLf
    
21.             .Text = findtext(i)
    
22.             If .Execute Then
    
23.                 c = c + 1
    
24.                 With .Parent
    
25.                     .Expand wdSentence
    
26.                     temp = .Text
    
27.                     If Right(temp, 1) <> Chr(13) Then temp = temp & vbCrLf
    
28.                     If InStr(info, vbCrLf & temp) = 0 Then
    
29.                         info = info & temp
    
30.                     Else
    
31.                         info = Replace(info, vbCrLf & findtext(i) & vbCrLf, "")
    
32.                         info = Replace(info, vbCrLf & temp, "|" & findtext(i) & vbCrLf & temp)
    
33.                         c = c - 1
    
34.                     End If
    
35.                 End With
    
36.             End If
    
37.             .Parent.WholeStory
    
38.         Next
    
39.     End With
    
40.     info = "共搜索到" & c & "条。" & vbCrLf & info
    
41.     Documents.Add.Content.Text = info
    
42. End Sub

复制代码

jiuyuedefeng

谢谢老大，完全解决了我的问题。对于常规的动词或名词形态变化，这个搜索程序完全适用。比如搜索abandon,例句里含有abandoned,"abandoned"是包含了"abandon"的。主要的思路是用最少的句子包含全部单词列表，老大给定程序完全可以解决。至于想要某个动词的不规则形态，大不了单独把它添加到单词列表里参加搜索。
最后再请老大帮个忙，现在程序是每次列出一个例句，能不能添加一个对话框，在程序执行前，可以自由输入想要给每个单词配几个句子。比如输入3，就会给单词列表里的单词配三个例句。