VBA实现字符串中单词计数并删除出现次数少于10次的单词

嗨，我来帮你调整代码实现这个需求~ 你的原代码是用字典做去重，现在我们只需要把字典的用途从“记录单词是否存在”改成“记录每个单词的出现次数”，再筛选出次数≥10的单词就行啦。

下面是修改后的完整代码，我加了详细注释方便你理解：

Function KeepFrequentWords(text As String, Optional delimiter As String = " ") As String
    Dim dictionary As Object
    Dim i, part
    
    ' 创建字典对象，用来存储单词和对应的出现次数
    Set dictionary = CreateObject("Scripting.Dictionary")
    ' 不区分大小写（比如"Hello"和"hello"算同一个单词），如果需要区分可以删掉这行
    dictionary.comparemode = vbTextCompare
    
    ' 第一步：拆分字符串，统计每个单词的出现次数
    For Each i In Split(text, delimiter)
        part = Trim(i) ' 去除单词前后的空格
        If part <> "" Then ' 跳过空字符串（比如连续分隔符产生的空值）
            If dictionary.Exists(part) Then
                ' 单词已存在，计数加1
                dictionary(part) = dictionary(part) + 1
            Else
                ' 单词不存在，添加进字典并设初始计数为1
                dictionary.Add part, 1
            End If
        End If
    Next
    
    ' 第二步：筛选出出现次数≥10的单词，存入临时数组
    Dim validWords() As String
    Dim wordIndex As Integer
    wordIndex = 0
    
    For Each part In dictionary.keys
        If dictionary(part) >= 10 Then
            wordIndex = wordIndex + 1
            ReDim Preserve validWords(1 To wordIndex)
            validWords(wordIndex) = part
        End If
    Next
    
    ' 第三步：把筛选后的单词用分隔符拼接成结果字符串
    If wordIndex > 0 Then
        KeepFrequentWords = Join(validWords, delimiter)
    Else
        ' 没有符合条件的单词时返回空字符串
        KeepFrequentWords = ""
    End If
    
    ' 释放对象内存
    Set dictionary = Nothing
End Function

关键改动说明： #

• 字典的Item不再存Nothing，而是存储对应单词的出现次数，这样就能实现计数功能
• 新增了筛选逻辑：遍历字典的所有键，只保留出现次数≥10的单词
• 用动态数组临时存储符合条件的单词，最后通过Join函数拼接成最终字符串

你可以直接用这个函数替换原来的RemoveDupeWords，或者在Excel单元格里直接调用，比如=KeepFrequentWords(A1)就能处理A1单元格的字符串啦~

备注：内容来源于stack exchange，提问作者user21226398