如何用代码提取文档中的英文单词数量？

zzpsx

附件.zip (15.01 KB, 下载次数: 3)

2023-4-6 20:26 上传

点击文件名下载附件

gwjkkkkk

Sub test()
    With CreateObject("VBScript.RegExp")
         .Global = True
         .Pattern = "[a-zA-Z']"
         For i = 1 To ActiveDocument.Content.Words.Count
             'MsgBox ActiveDocument.Content.Words(i)
             If .test(ActiveDocument.Content.Words(i)) Then r = r + 1
         Next i
    End With
    MsgBox r
End Sub

zzpsx

我自己鼓捣了一段，统计结果有点误差。
Sub InsertTextAndCountWords()
    ' 获取文档的第一段
    Set first_paragraph = ActiveDocument.Paragraphs(1)
    ' 在段落开头插入指定文本
    first_paragraph.Range.InsertBefore "体裁 记叙文 难度★★★★ 词数（" & CountWords(ActiveDocument.Range) & "个单词）" & vbNewLine
    ' 居中对齐
    first_paragraph.Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
End Sub

Function CountWords(rng As Range) As Long
    ' 统计单词数
    Dim words As Long
    words = 0
    With rng.Find
        .MatchWildcards = True
        .Text = "<[A-Za-z]{1,}>"
        .Execute
        Do While .Found
            words = words + 1
            .Execute
        Loop
    End With
    CountWords = words
End Function

剑指E

1. Sub kkkk()
   
2.     Dim rg As Range, ostr$, n&
   
3.     ostr = ActiveDocument.Content
   
4.     ostr = Replace(Replace(ostr, vbCrLf, " "), vbCr, " ")
   
5.     ostr = Trim(ostr)
   
6.     n = UBound(Split(ostr, " ")) + 1
   
7.     Set rg = Application.ActiveDocument.Range(0, 0)
   
8.     rg.Select
   
9.     Selection.TypeParagraph
   
10.     rg.Text = "体裁 记叙文 难度★★★★  词数 （" & n & "）"
    
11.     With ActiveDocument.Paragraphs(1)
    
12.         .Format.Alignment = wdAlignParagraphCenter
    
13.         .Range.Font.Size = 14
    
14.         .Range.Font.Bold = wdToggle
    
15.     End With
    
16. End Sub

复制代码

zzpsx

问题已解决，谢谢各位高手的神代码。

zzpsx

剑指E 发表于 2023-4-6 22:53

高手您好，代码计算单词和手动统计数量略有差距。

杨建营

zzpsx 发表于 2023-4-15 20:26
高手您好，代码计算单词和手动统计数量略有差距。

多出来的字是插入的那一行的，自己数数看看。

zzpsx

杨建营 发表于 2023-4-15 21:46
多出来的字是插入的那一行的，自己数数看看。

我的理解不是这样的。截图中167/191表示，167为选中部分的英文词数，191为整个文档的词数。
代码计算的英语词数为163，和word自己计算的167有差距。可能代码没有把阿拉伯数字计算进去。我想把阿拉伯数字也算进去。

zzpsx

Sub GetWordsCount_ActivePage()
'UpdatebyExtendoffice20180829
    Dim xWord As Long
    xWord = ActiveDocument.Bookmarks("\Page").Range.ComputeStatistics(wdStatisticWords)
    MsgBox "The number of words of atcive page: " & xWord, vbInformation, "Kutools for Word"
End Sub
这个代码好像是准确统计的

剑指E

zzpsx 发表于 2023-4-15 20:26
高手您好，代码计算单词和手动统计数量略有差距。

删掉第一行（即标题）看看，