如何用VBA识别Excel中连续重复的单词？现有代码需优化

完全可以实现精准识别连续相邻重复的单词，以下是修改后的VBA代码，能匹配你给出的示例预期结果：

Sub FindAdjacentRepeats()
    Dim lastRow As Long
    Dim i As Long, j As Long
    Dim cellValueA As String
    Dim wordsA As Variant
    Dim dict As Object
    Dim sheet1 As Worksheet
    
    Set sheet1 = ThisWorkbook.Worksheets("Sheet1")
    ' 获取A列最后一行数据
    lastRow = sheet1.Cells(sheet1.Rows.Count, 1).End(xlUp).Row
    
    For i = 1 To lastRow
        cellValueA = sheet1.Cells(i, 1).Value
        If cellValueA <> "" Then
            wordsA = Split(cellValueA, " ")
            Set dict = CreateObject("scripting.dictionary")
            
            ' 遍历单词数组，检查当前单词与下一个是否连续重复
            For j = LBound(wordsA) To UBound(wordsA) - 1
                If wordsA(j) = wordsA(j + 1) Then
                    ' 用字典去重，避免同一单词多次连续重复被重复记录
                    If Not dict.exists(wordsA(j)) Then
                        dict.Add wordsA(j), wordsA(j)
                    End If
                End If
            Next j
            
            ' 将字典中的结果写入B列（对应预期结果列）
            If dict.Count > 0 Then
                sheet1.Cells(i, 2).Value = Join(dict.items, " ")
            Else
                sheet1.Cells(i, 2).Value = ""
            End If
        Else
            sheet1.Cells(i, 2).Value = ""
        End If
    Next i
End Sub

关键修改说明 #

• 核心逻辑从统计全局单词出现次数改为遍历检查相邻单词是否相同：通过循环数组索引，对比wordsA(j)和wordsA(j+1)的值，判断是否连续重复。
• 保留字典dict的作用：避免同一单词多次连续重复（比如Auto Auto Auto这类情况）被重复记录，确保每个连续重复的单词只输出一次。
• 输出目标列调整为B列，和你给出的示例预期结果列对应。

示例数据验证 #

运行代码后，你的示例数据会得到如下结果：

完全符合预期要求。

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