Excel VBA宏问题：删除A列重复值时两个都被误删如何修正

问题根源 #

原有代码的问题出在判断逻辑里加入了MemoCanc变量的匹配规则：

首次检测到相邻重复值删除当前行后，会把当前值存入MemoCanc，下一轮循环到上一行时，会触发MemoCanc = .Cells(K, 1)的判断条件，直接把剩下的唯一值也删掉，就出现了两个重复项全被删除的问题。

修正后代码 #

Sub Elina_Tutti_I_Doppioni_2()
    Dim LastRow As Long, K As Long
    
    Application.ScreenUpdating = False

    With ActiveSheet
        ' 对A列排序，保证重复值相邻
        .Columns("A").Sort .[a1], Header:=xlGuess
        ' 计算A列最后一个非空行号，避免中间有空行时计算错误
        LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
 
        ' 从最后一行向上遍历，避免删除行导致的行号偏移
        For K = LastRow To 2 Step -1
            ' 仅判断当前行与上一行值是否一致，一致则删除当前行、保留上一行
            If .Cells(K, 1) = .Cells(K - 1, 1) Then
                .Rows(K).EntireRow.Delete
            End If
        Next
    End With
  
    Application.ScreenUpdating = True
End Sub

核心修改说明 #

• 移除了MemoCanc相关的变量定义和判断逻辑，避免触发重复删除
• 优化了最后一行的计算逻辑，原[COUNTA(A:A)]在A列中间存在空行时会计算错误，改用End(xlUp)的方式兼容性更强
• 保留了原有倒序遍历、排序、关闭屏幕更新的逻辑，运行效率不受影响

可选优化 #

如果你的A列有固定表头，可将排序参数中的Header:=xlGuess改为Header:=xlYes，避免表头参与排序和去重判断。

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