如何用VBA删除重复行且保留End行？现有代码存在异常

你的需求是保留新增的End行，删除其上方所有A列值重复的行。原代码存在两个问题：

• 仅保留重复项的第一行，无法满足删除所有重复行或保留最后一个重复项的需求
• 操作范围限制在A1:Z列，容易造成误解，未明确实现整行删除

解决方案代码 #

方案1：保留每个A列值的最后一行，删除前面的重复行 #

如果你希望每个A列值仅保留最后一次出现的行，删除之前的重复项，使用以下代码：

Private Sub clearDuplicatesKeepLast()
    Dim lastRow As Long
    Dim ws As Worksheet
    Set ws = ActiveSheet '可替换为指定工作表，如ThisWorkbook.Worksheets("Sheet1")
    
    '定位End行的行号
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    Dim seen As Object
    Set seen = CreateObject("Scripting.Dictionary")
    
    '从下往上遍历，避免删除行后行号错乱
    For i = lastRow - 1 To 1 Step -1
        Dim key As String
        key = CStr(ws.Cells(i, 1).Value)
        If seen.Exists(key) Then
            ws.Rows(i).Delete '删除重复行
        Else
            seen(key) = True '标记该值已出现
        End If
    Next i
End Sub

方案2：删除所有A列值重复的行（仅保留出现一次的行） #

如果你希望彻底删除所有A列值重复的行（只要值出现多次，所有对应行都删除），使用以下代码：

Private Sub clearAllDuplicates()
    Dim lastRow As Long
    Dim ws As Worksheet
    Set ws = ActiveSheet
    
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    Dim countDict As Object
    Set countDict = CreateObject("Scripting.Dictionary")
    
    '第一步：统计每个A列值的出现次数
    For i = 1 To lastRow - 1
        Dim key As String
        key = CStr(ws.Cells(i, 1).Value)
        countDict(key) = countDict(key) + 1
    Next i
    
    '第二步：从下往上删除出现次数>1的行
    For i = lastRow - 1 To 1 Step -1
        key = CStr(ws.Cells(i, 1).Value)
        If countDict(key) > 1 Then
            ws.Rows(i).Delete
        End If
    Next i
End Sub

原代码问题说明 #

• Range("A1:Z" & x).RemoveDuplicates 操作范围仅限定在A-Z列，若工作表存在Z列以外的数据，会让你误以为只是清空内容，但实际Excel的RemoveDuplicates是删除整行的。直接使用Rows(i).Delete可以明确删除整行。
• 原代码默认保留第一个重复项，无法满足更灵活的去重需求，上述代码通过字典遍历实现了自定义去重逻辑。

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