请教如何通过代码统计文档中每个单词出现的频次？

wdpfox

shenjianrong163 发表于 2021-3-5 20:57
重新更改代码，附件供参考：

学品高，人品强，耐心解答，好人平安！

tangqingfu

shenjianrong163 发表于 2021-3-5 20:57
重新更改代码，附件供参考：

请教shenjianrong163兄，如何通过代码做到实现如下功能：
若工作表sheet1中的单词存在于工作表sheet2中，则在工作表sheet2中的G、H、I列中添加对应的“中文”、“音标”及”课文来源“？
单词不区分大、小写

tangqingfu

shenjianrong163 发表于 2021-3-5 20:57
重新更改代码，附件供参考：

请教大师，如何修改代码，做到单词”频次“置于A列，”单词“置于B列？

tangqingfu

shenjianrong163 发表于 2021-3-5 20:57
重新更改代码，附件供参考：

请教如何统计文档中每个单词出现的频次？
按单词出现先后顺序统计各个单词出现的频次，单词不区分大、小写字母（WHAT、What、what作为同一个单词进行统计，像part-time这样带连字符的单词也作视为一个单词），请教如何通过VBA代码实现？

shenjianrong163

tangqingfu 发表于 2022-4-3 20:47
请教如何统计文档中每个单词出现的频次？
按单词出现先后顺序统计各个单词出现的频次，单词不区分大、小 ...

Sub 统计各单词出现的次数()
    Dim c$, s$, d, d1, k, i&, j&, temp$, reg, Match, Matches, arr, brr(), wb
    s = ActiveDocument.Content.Text
    Set d = CreateObject("Scripting.Dictionary")
    Set d1 = CreateObject("Scripting.Dictionary")
    Set wb = CreateObject("Excel.Application")
    d.CompareMode = vbTextCompare '不区分大小写
    Set reg = CreateObject("VBScript.RegExp")
    With reg
        .Pattern = "[A-Za-z]+"
        .Global = True
        Set Matches = .Execute(s)
        For Each Match In Matches
            With Match
                If d.Exists(.Value) Then d(.Value) = d(.Value) + 1 Else d.Add .Value, 1
            End With
        Next
        k = d.Keys
'        For i = 0 To UBound(k) - 1
'            For j = i + 1 To UBound(k)
'                If d(k(i)) < d(k(j)) Then
'                    temp = k(i)
'                    k(i) = k(j)
'                    k(j) = temp
'                End If
'            Next
'        Next
        ReDim brr(1 To UBound(k) + 2, 1 To 5)
        j = 1
        brr(j, 1) = "频次": brr(j, 2) = "单词": brr(j, 3) = "中文": brr(j, 4) = "音标": brr(j, 5) = "课文来源"
        For i = 0 To UBound(k)
            j = j + 1
            brr(j, 1) = d(k(i)) & "次"
            brr(j, 2) = k(i)
        Next
    End With
    With wb.WorkBooks.Open(ActiveDocument.Path & "\单词表.xls")
        With .Sheets("全部")
            arr = .UsedRange.Value
            For i = 2 To UBound(arr)
                d1(LCase(arr(i, 1))) = Array(arr(i, 2), arr(i, 3), arr(i, 4))
            Next
        End With
        With .Sheets("Sheet1")
            .UsedRange.ClearContents
            For i = 2 To UBound(brr)
                If d1.Exists(LCase(brr(i, 2))) Then
                    brr(i, 3) = d1(LCase(brr(i, 2)))(0)
                    brr(i, 4) = d1(LCase(brr(i, 2)))(1)
                    brr(i, 5) = d1(LCase(brr(i, 2)))(2)
                End If
            Next
            .[A1].Resize(UBound(brr), 5) = brr
        End With
        .Close True
    End With
    wb.Quit
    Set wb = Nothing
    MsgBox "单词频次统计完成!"
End Sub

以木为马

我竟然活捉一群大佬。。。。