excel如何通过vba统计多行英文内容任意连续2个单词，3个单词，4个单词...的词频

Question

亲们，已经有这样的vba程序（见附图），但是只适用于中文，请问能不能修改一下能用于英文，非常感谢vba程序如下：Private Sub CommandButton1_Click()Range("a2:b99999").ClearContentsDim arr(), brr(), crr(), dic, dic2, k As LongSet dic = CreateObject("Scripting.Dictionary")Set dic2 = CreateObject("Scripting.Dictionary")On Error Resume Nextarr = Range("d1:d" & [d65535].End(3).Row)ReDim brr(1 To [d65535].End(3).Row, 1 To 1)For i = 1 To UBound(arr) For j = 1 To Len(arr(i, 1)) Str2 = Mid(arr(i, 1), j, 1) If (Asc(Str2) < 0 And Asc(Str2) > -22000) Or Asc(Str2) < -24300 Then brr(i, 1) = brr(i, 1) & Mid(arr(i, 1), j, 1) Else If Right(brr(i, 1), 1) <> " " Then brr(i, 1) = brr(i, 1) & " " End If Next jNext iReDim crr(1 To 100000, 1 To 2)k = 1lxzf = [c3]cp = [c5]For i = 1 To UBound(brr) ltws = Split(brr(i, 1), " ") For s = 0 To UBound(ltws) If Len(ltws(s)) < lxzf Then GoTo haha For j = 1 To Len(ltws(s)) - lxzf + 1 str3 = Mid(ltws(s), j, lxzf) '连续字符= dic(str3) = dic(str3) + 1 If dic(str3) >= cp Then '词频>= If Not dic2.exists(str3) Then dic2(str3) = k crr(k, 1) = str3 crr(k, 2) = dic(str3) k = k + 1 Else crr(dic2(str3), 2) = dic(str3) End If End If Next jhaha: Next sNext iRange("a2").Resize(k - 1, 2) = crrEnd Sub

Answer 1

给你做了一个单个词统计的，双词多词统计方法完全不一样，估计那些个标点符号都要综合考虑了。

Sub Comk1()
Range("a2:b59999").ClearContents
    Dim lngFile As Long
    Set dic = CreateObject("Scripting.Dictionary")
    Dim arr, brr, tmp
    Dim i, k As Integer
    Dim sFile As String
    For Each Rng In Range("d1:d" & [d65535].End(3).Row)
    sFile = sFile & " " & Rng
    Next
    lngFile = FreeFile
    sFile = Replace(sFile, ".", Space(1))
    sFile = Replace(sFile, ",", Space(1))
    sFile = Replace(sFile, "?", Space(1))
    sFile = Replace(sFile, vbCrLf, Space(1))
    tmp = Split(sFile, Space(1))
    For i = 1 To UBound(tmp)
        tmp(i) = Trim(tmp(i))
        If Len(tmp(i)) Then
            If dic.Exists(tmp(i)) Then
                dic.Item(tmp(i)) = dic.Item(tmp(i)) + 1
            Else
                dic.Add tmp(i), 1
            End If
        End If
    Next

  '输出结果
  '[a1].Resize(dic.Count) = WorksheetFunction.Transpose(dic.Keys)
  '[b1].Resize(dic.Count) = WorksheetFunction.Transpose(dic.items)
  arr = dic.keys
  brr = dic.Items
  For i = 0 To dic.Count - 1
    If brr(i) > [c5] Then
        j = j + 1
        Cells(j, 1) = arr(i)
        Cells(j, 2) = brr(i)
    End If
  Next
    Set dic = Nothing
End Sub

Answer 2

可以通过SPLIT分隔成数组加入字典之后统计追问

请问能不能帮助修改一下呢

Answer 3

VBA对英文肯定是有需求的，因为代码输入时都有联想功能，你只需要去选择就行，不一定要求会读会写，但肯定要认得，不认得会困难很多，认得它就需要去记了，所以学它还是有点英语基础好点。