仅清除相邻重复项的Excel VBA代码优化需求

原代码使用Scripting.Dictionary记录所有出现过的F、G列配对，会清除所有非首次出现的重复项，不符合仅清除正下方相邻重复项的需求。以下是针对性的修改方案：

修改思路 #

不需要全局记录所有配对，只需要跟踪上一个未被清空的有效配对：

• 遍历每一行时，仅和上一个非重复的配对做对比
• 当前行与基准配对完全一致时，清空当前行的F、G列
• 当前行与基准配对不同时，更新基准配对为当前行内容，重置判断逻辑

修改后的代码 #

Sub clearAdjacentDups()
    Dim lngMyRow As Long
    Dim lngLastRow As Long
    Dim prevPair As String ' 存储上一个需要对比的有效配对

    Application.ScreenUpdating = False

    ' 获取F、G列最后一行有数据的行号
    lngLastRow = Range("F:G").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    
    ' 初始化基准配对（假设数据从第1行开始，有表头则修改行号）
    If lngLastRow >= 1 Then
        prevPair = CStr(Cells(1, 6) & Cells(1, 7))
    End If

    ' 从第2行开始遍历判断
    For lngMyRow = 2 To lngLastRow
        Dim currPair As String
        currPair = CStr(Cells(lngMyRow, 6) & Cells(lngMyRow, 7))
        
        ' 仅当当前配对与基准配对一致且非空时，清空当前行
        If currPair = prevPair And currPair <> "" Then
            Range(Cells(lngMyRow, 6), Cells(lngMyRow, 7)).ClearContents
        Else
            ' 更新基准配对为当前行内容，重置判断逻辑
            prevPair = currPair
        End If
    Next lngMyRow

    Application.ScreenUpdating = True
End Sub

关键逻辑说明 #

1. 移除Dictionary依赖：不再全局记录所有历史配对，仅关注相邻的有效行，避免误清除非相邻的重复项
2. 基准配对动态更新：每次遇到非重复行时，立即将其设为新的对比基准，确保后续判断只针对最近的非重复项
3. 空行处理：加入currPair <> ""判断，避免空行干扰基准配对的更新

适配表头场景 #

如果数据上方有表头（比如表头在第1行，数据从第2行开始），只需修改两处：

' 初始化基准配对为第2行数据
If lngLastRow >= 2 Then
    prevPair = CStr(Cells(2, 6) & Cells(2, 7))
End If

' 从第3行开始遍历
For lngMyRow = 3 To lngLastRow

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