时间戳

首页 > 解决方案 > 删除重复行，保留最后并首先删除

excel - 删除重复行，保留最后并首先删除

问题描述

在此处输入图像描述

我正在尝试提出在 D 列中查找任何重复文本的代码，然后删除第一个重复文本所在的整行。行之间有空格，因此.End(xl)Up除非您是能够以某种方式定位整个列，而不管行之间的空白如何。

到目前为止，我已经尝试了两种方法，但都没有达到我的预期。

这是我第一个不起作用的方法，因为工作表有一个大纲：

Sub test()

ActiveSheet.Range("D:D").RemoveDuplicates Columns:=1, header:=xlNo

End Sub

这是我从另一个运行了几分钟但似乎没有达到我想要实现的目标的站点获得的第二种方法。

Sub Row_Dupe_Killer_Keep_Last()
Dim lrow As Long

For lrow = Cells(Rows.Count, "D").End(xlUp).Row To 2 Step -1
    If Cells(lrow, "D") = Cells(lrow, "D").Offset(-1, 0) Then
       Cells(lrow, "D").Offset(-1, 0).EntireRow.Delete
    End If

Next lrow
End Sub

有没有人有任何建议或提示？我已经用我有限的技能工作了几天，并且无法找到一种方法来做到这一点......提前感谢您的时间。

标签： excelvba

解决方案

编辑：现在忽略空白

编辑：修改为能够更改起始行

您可能想要做的是将数据拉入数组并在数组中搜索重复项。Excel 处理数组的速度比遍历每个单元格的速度要快得多。

下面的代码就是这样做的。它将单独留下 D1（例如在您的示例代码中），并将删除所有重复项的整行，只留下最后一项。

为了处理删除行，我们将所有重复项添加到名为 rngDelete 的范围对象中，并一次删除所有行。这将使其运行速度比一个一个删除要快得多。

Sub Row_Dupe_Killer_Keep_Last()
    Dim vData As Variant
    Dim rngDelete As Range
    Dim lrow As Long, lrowSearch As Long
    Dim lStartRow as long

    'Change this to the row you wish to start with (the top row)
    lStartRow = 22

    'Get all of the data from the cells into a variant array
    'Normally I would prefer to use usedrange, but this method is fine
    '(Note: Change the 2 to 1 if you want to include the entire column including Row number 1)
    vData = Range(Cells(lStartRow, "D").Address & ":" & Cells(Rows.Count, "D").End(xlUp).Address)

    'Search for duplicates
    'First, loop through backwards one by one
    For lrow = UBound(vData) To LBound(vData) Step -1
        'now loop through forwards (up to the point where we have already looked)
        For lrowSearch = LBound(vData) To lrow
            'Check if we have a duplicate
            If Not IsError(vData(lrow, 1)) And Not IsError(vData(lrowSearch, 1)) Then
                If lrow <> lrowSearch And vData(lrow, 1) = vData(lrowSearch, 1) And vData(lrow, 1) <> "" Then
                    'We have a duplicate! Let's add it to our "list to delete"
                    If rngDelete Is Nothing Then
                        'if rngDelete isn't set yet...
                        Set rngDelete = Range("D" & lrowSearch + lStartRow-1)
                    Else
                        'if we are adding to rngDelete...
                        Set rngDelete = Union(rngDelete, Range("D" & lrowSearch + lStartRow-1))
                    End If
                End If
            End If
        Next lrowSearch
    Next lrow

    'Delete all of the duplicate rows
    If Not rngDelete Is Nothing Then
        rngDelete.EntireRow.Delete
    End If
End Sub

推荐阅读