繁体字文章中汉字使用频率的统计方法（VBA）感恩 sylun 老师帮助！

praijna

413191246se 发表于 2019-8-23 21:50
函数、数组、字典、递归、类……都不会，戴老师 讲得太高级！

老师，早上好！
我凑了以下这段代码，您帮忙看看，如果将字典的结果，HZ、SL 按 SL 从大到小排序的结果，另存为一个 word 档？
Sub TeaHorseRoad()
Dim i As Integer
Dim HanZi
Dim Ta As Paragraph

Application.ScreenUpdating = False
ST = Timer

Set HanZi = CreateObject("Scripting.Dictionary")

   With ActiveDocument
   
   For Each Ta In .Paragraphs
   With Ta.Range.Find
    .Execute "[!一-龥^11^13]", , , 1, , , , , , "", 2
   End With

            j = Ta.Range.Characters.Count
            For i = 1 To j
                XT = Ta.Range.Characters(i)
                If XT <> vbCr Then
      If HanZi.Exists(XT) = False Then
         HanZi.Add XT, 1
               Else
         HanZi.Item(XT) = HanZi.Item(XT) + 1
     End If
     End If


Next
Next

HZ = HanZi.Keys

SL = HanZi.Items

End With

MsgBox "Done!共" & Format(Timer - ST, "0.00") & "秒"

End Sub

sylun

可试试

1. Sub test()
   
2.     '计算活动文档的各汉字出现次数并排序
   
3.     Dim i As Integer
   
4.     Dim myRegexp As Object
   
5.     Dim Matches As Object
   
6.     Dim Match As Object
   
7.     Dim d As Object
   
8.     Dim key As Variant
   
9.     Dim CNchar() As String
   
10.    
    
11.     Set myRegexp = CreateObject("VBScript.Regexp")
    
12.     With myRegexp
    
13.         .Global = True
    
14.         .Pattern = "[\u4E00-\u9FA5]"
    
15.         Set Matches = .Execute(ActiveDocument.Content.Text)
    
16.     End With
    
17.    
    
18.     Set d = CreateObject("Scripting.Dictionary")
    
19.     For Each Match In Matches
    
20.         d(Match.Value) = d(Match.Value) + 1
    
21.     Next
    
22.     key = d.keys
    
23.     ReDim CNchar(UBound(key))
    
24.     For i = 0 To UBound(key)
    
25.         CNchar(i) = key(i) & vbTab & d(key(i))
    
26.     Next
    
27.         
    
28.     Application.ScreenUpdating = False
    
29.     With Documents.Add.Content
    
30.         .Text = "汉字" & vbTab & "字频" & vbCrLf & Join(CNchar, vbCrLf)
    
31.         .Sort True, 2, wdSortFieldNumeric, wdSortOrderDescending, 1, wdSortFieldSyllable, wdSortOrderAscending
    
32.     End With
    
33.     Application.ScreenUpdating = True
    
34. End Sub
    
35. 
    

复制代码

：

praijna

sylun 发表于 2019-8-26 21:42
可试试：

刚刚试了一下，一瞬间就完成了，太厉害了！感恩老师！

praijna

sylun 发表于 2019-8-26 21:42
可试试：

老师，您好！
发现其中有些汉字不能被统计到，比如：&#151331;，

sylun

praijna 发表于 2019-8-27 09:40
老师，您好！
发现其中有些汉字不能被统计到，比如：&#151331;，

这个可能涉及到扩展字库和代码页等汉字编码方面知识，没有研究。

praijna

sylun 发表于 2019-8-27 21:36
这个可能涉及到扩展字库和代码页等汉字编码方面知识，没有研究。

好的，感恩老师！

praijna

sylun 发表于 2019-8-27 21:36
这个可能涉及到扩展字库和代码页等汉字编码方面知识，没有研究。

老师，早上好！
您的那句 set matches=.execute(Activedocument.contnt.text)，能否反过来用，包含以下代码运行之后的结果数据：
With ActiveDocument.Range.Find
    .Execute "[!一-龥^11^13^32]", , , 1, , , , , , "", 2
   End With



感恩！