[已解决]我想在excel中用vba语句统计word文档中包含特定字符的词组并复制到excel中。

zyq2010

如附件。
1，在excel中写vba：我想在excel中用vba语句统计word文档中以“社会”开头，后面跟着2个任意字的词，即每个词总共4个字，如“社会主义”、“社会和谐”、"社会而奋"(有的不一定是一个有完整含义的词，这个就是这种)等等，并把该文档中所有符合这个要求的这些词依次自动录入到excel首列当中。
2，在word中写vba语句：如果我不在excel中写vba语句，而在word中写vba语句，但还统计到excel中去，又该如何操作合适？
我写了一段代码（在附件表1的代码区），不过根本不能完全解决问题。似懂非懂的感觉，请老师们指点一下，多谢你们的辛苦。
3，如果在excel中在不打开word的情况下达到目的代码和打开word的情况下达到目的代码是否有区别啊，如果有在哪里

最佳答案

月排行榜 / 总排行榜

hwc2ycy

2013-5-23 22:36

数目统计不对，

1. Sub 统计词语()
   
2.     Dim objWord As Object
   
3.     Dim strWordfile$
   
4.     Dim strFind$, arr
   
5.     Dim strWhat$
   
6.     Dim blFind As Boolean
   
7.     On Error GoTo ErrorHandler
   
8.     Application.ScreenUpdating = False
   
9.     Do
   
10.         strWhat = Application.InputBox(prompt:="请输入要查找的字符串", Title:="提示", Default:="社会", Type:=2)
    
11.     Loop Until strWhat <> "False"
    
12. 
    
13. 
    
14.     strWordfile = "89.docx"
    
15.     Set objWord = GetObject(ThisWorkbook.Path & Application.PathSeparator & _
    
16.                             strWordfile)
    
17. 
    
18.     With objWord.ActiveWindow.Selection.Find
    
19.         .ClearFormatting
    
20.         .Text = "社会[!^1-^125]{2}"
    
21.         .Replacement.Text = ""
    
22.         .Forward = True
    
23.         .Wrap = wdFindContinue
    
24.         .MatchWildcards = True
    
25.         Do
    
26.             blFind = .Execute
    
27.             strFind = strFind & objWord.ActiveWindow.Selection.Text & ","
    
28.         Loop Until Not blFind
    
29.     End With
    
30. 
    
31.     If Len(strFind) > 1 Then
    
32.         strFind = Left(strFind, Len(strFind) - 1)
    
33.         objWord.Close False
    
34.         Set objWord = Nothing
    
35.         arr = Split(strFind, ",")
    
36.         Columns(1).ClearContents
    
37.         Range("a1").Resize(UBound(arr)).Value = WorksheetFunction.Transpose(arr)
    
38.         MsgBox "统计完成", vbInformation + vbOKOnly
    
39.     End If
    
40.     Application.ScreenUpdating = True
    
41.     Exit Sub
    
42. ErrorHandler:
    
43.     MsgBox Err.Number & vbCrLf & _
    
44.            Err.Description
    
45.     Application.ScreenUpdating = True
    
46. End Sub
    

复制代码

跳转到最佳答案楼层

hwc2ycy

1. Sub 统计词语()
   
2.     Dim objWord As Object
   
3.     Dim strWordfile$
   
4.     Dim strFind$, arr
   
5.     Dim strWhat$
   
6.     Dim blFind As Boolean
   
7.     On Error GoTo ErrorHandler
   
8.     Application.ScreenUpdating = False
   
9.     Do
   
10.     strWhat = Application.InputBox(prompt:="请输入要查找的字符串", Title:="提示", Default:="社会", Type:=2)
    
11.     Loop Until strWhat <> "False"
    
12.    
    
13. 
    
14.     strWordfile = "89.docx"
    
15.     Set objWord = GetObject(ThisWorkbook.Path & Application.PathSeparator & _
    
16.                             strWordfile)
    
17. 
    
18.     With objWord.ActiveWindow.Selection.Find
    
19.         .ClearFormatting
    
20.         .Text = "社会[!^1-^125]{2}"
    
21.         .Replacement.Text = ""
    
22.         .Forward = True
    
23.         .Wrap = wdFindContinue
    
24.         .MatchWildcards = True
    
25.         Do
    
26.             blFind = .Execute
    
27.             strFind = strFind & objWord.ActiveWindow.Selection.Text & ","
    
28.         Loop Until Not blFind
    
29.     End With
    
30.    
    
31.     If Len(strFind) > 1 Then
    
32.         strFind = Left(strFind, Len(strFind) - 1)
    
33.         objWord.Close False
    
34.         Set objWord = Nothing
    
35.         arr = Split(strFind, ",")
    
36.         Columns(1).ClearContents
    
37.         Range("a1").Resize(UBound(arr) + 1).Value = WorksheetFunction.Transpose(arr)
    
38.         MsgBox "统计完成", vbInformation + vbOKOnly
    
39.     End If
    
40.     Application.ScreenUpdating = True
    
41.     Exit Sub
    
42. ErrorHandler:
    
43.     MsgBox Err.Number & vbCrLf & _
    
44.            Err.Description
    
45.     Application.ScreenUpdating = True
    
46. End Sub

复制代码

hwc2ycy

后面那个字符我强制要求是中文了。

hwc2ycy

数目统计不对，

1. Sub 统计词语()
   
2.     Dim objWord As Object
   
3.     Dim strWordfile$
   
4.     Dim strFind$, arr
   
5.     Dim strWhat$
   
6.     Dim blFind As Boolean
   
7.     On Error GoTo ErrorHandler
   
8.     Application.ScreenUpdating = False
   
9.     Do
   
10.         strWhat = Application.InputBox(prompt:="请输入要查找的字符串", Title:="提示", Default:="社会", Type:=2)
    
11.     Loop Until strWhat <> "False"
    
12. 
    
13. 
    
14.     strWordfile = "89.docx"
    
15.     Set objWord = GetObject(ThisWorkbook.Path & Application.PathSeparator & _
    
16.                             strWordfile)
    
17. 
    
18.     With objWord.ActiveWindow.Selection.Find
    
19.         .ClearFormatting
    
20.         .Text = "社会[!^1-^125]{2}"
    
21.         .Replacement.Text = ""
    
22.         .Forward = True
    
23.         .Wrap = wdFindContinue
    
24.         .MatchWildcards = True
    
25.         Do
    
26.             blFind = .Execute
    
27.             strFind = strFind & objWord.ActiveWindow.Selection.Text & ","
    
28.         Loop Until Not blFind
    
29.     End With
    
30. 
    
31.     If Len(strFind) > 1 Then
    
32.         strFind = Left(strFind, Len(strFind) - 1)
    
33.         objWord.Close False
    
34.         Set objWord = Nothing
    
35.         arr = Split(strFind, ",")
    
36.         Columns(1).ClearContents
    
37.         Range("a1").Resize(UBound(arr)).Value = WorksheetFunction.Transpose(arr)
    
38.         MsgBox "统计完成", vbInformation + vbOKOnly
    
39.     End If
    
40.     Application.ScreenUpdating = True
    
41.     Exit Sub
    
42. ErrorHandler:
    
43.     MsgBox Err.Number & vbCrLf & _
    
44.            Err.Description
    
45.     Application.ScreenUpdating = True
    
46. End Sub
    

复制代码