如何修改Excel 2016 VBA代码，仅查找列内单元格指定重复词

核心修改思路 #

原代码是查找单元格内所有重复单词，现在调整为只检查DuplicateWords中指定的多词短语，主要做了以下优化：

• 把指定短语字符串拆分为数组，方便逐个校验
• 直接统计指定短语在单元格内的出现次数，支持多词短语识别
• 加入不区分大小写匹配，同时避免结果重复添加同一短语

修改后的完整代码 #

Sub FindSpecifiedDuplicates()
    Dim i As Long
    Dim WS As Worksheet
    Dim TargetPhrases As Variant
    Dim DubStr As String
    Dim Phrase As Variant
    Dim PhraseCount As Integer
    Dim CellText As String
    
    Set WS = ActiveSheet
    
    ' 指定需要检查的重复短语，用逗号分隔
    Dim DuplicateWords As String
    DuplicateWords = "Telephone call,Seen by team"
    
    ' 将短语字符串拆分为数组，去除每个短语前后的空格
    TargetPhrases = Split(DuplicateWords, ",")
    For Each Phrase In TargetPhrases
        Phrase = Trim(Phrase)
    Next Phrase
    
    ' 遍历第9列（I列）的所有非空单元格
    For i = 1 To WS.Cells(Rows.Count, 9).End(xlUp).Row
        CellText = UCase(WS.Cells(i, 9).Value) ' 统一转为大写，实现不区分大小写匹配
        DubStr = ""
        
        ' 遍历每个指定短语，统计出现次数
        For Each Phrase In TargetPhrases
            If Phrase <> "" Then ' 跳过空项
                ' 通过字符串替换计算短语出现次数
                PhraseCount = (Len(CellText) - Len(Replace(CellText, UCase(Phrase), ""))) / Len(UCase(Phrase))
                
                ' 次数大于1且未在结果中时，添加到结果字符串
                If PhraseCount > 1 And InStr(1, DubStr, Phrase) = 0 Then
                    DubStr = DubStr & Phrase & " "
                End If
            End If
        Next Phrase
        
        ' 将结果写入第15列（O列）
        WS.Cells(i, 15).Value = Trim(DubStr)
    Next i
End Sub

关键修改细节 #

• 短语数组处理：把DuplicateWords按逗号拆分后，逐个去除短语前后的空格，避免因输入时的空格导致匹配失败
• 多词短语识别：不再拆分单元格内容为单个单词，而是用Len(Replace(...))的方式统计短语出现次数，完美支持"Telephone call"这类多词短语的重复检查
• 大小写兼容：将单元格文本和目标短语统一转为大写后再匹配，就算单元格里写的是"telephone call"也能被识别
• 结果去重：添加短语到结果前先检查是否已存在，避免同一短语多次出现在输出列中

内容的提问来源于stack exchange，提问作者BradS