删除重复行，保留最后一行

YEJINHAI

大家好！ 当A B C D列相同的时候，删除重复行，保留最后一行。特别注意：E F 列不参与比较。
这个宏怎样写。
数据量在1.8万行，考虑到运算时间。

白色GG

Option Explicit

Sub 删除重复行()
    Dim rngData As Range
    Dim i As Long
    Dim lRowsStar As Long
    Dim lRowsEnd As Long
   
    Set rngData = Sheet1.UsedRange
    lRowsStar = rngData.Row
    lRowsEnd = lRowsStar + rngData.Rows.Count - 1
   
    For i = lRowsStar To lRowsEnd
        If rngData.Cells(i, 1) & rngData.Cells(i, 2) & rngData.Cells(i, 3) & rngData.Cells(i, 4) = rngData.Cells(i + 1, 1) & rngData.Cells(i + 1, 2) & rngData.Cells(i + 1, 3) & rngData.Cells(i + 1, 4) Then
            rngData.Range(i & ":" & i).Delete
        End If
    Next
   
    Set rngData = Nothing
End Sub

由于删除行后，总行数减少了。上述代码没有考虑这一点，所以还可以优化。

另外还有一个思路：通过上面的代码，找出需要删除的行，在某个空白列做个标记。等全部查找完后，再以标记列过滤，找出全部需要删除的行，一次性删除。

两种方法最大的区别在与删除的次数不同，效率应该不同，推测应该是第二种思路的效率高（不过没有实测对比过）。

供参考。

YEJINHAI

我把代码复制到宏，运行后好像没有反应？

白色GG

你看看这行代码：
Set rngData = Sheet1.UsedRange
这里面取的是Sheet1，你那里如果不是这个，就修改为你那里的工作表名吧。

zhaogang1960

短信收到，请测试
Sub Macro1()
    Dim arr, t, d As Object, i&, j&, m&
    Set d = CreateObject("scripting.dictionary")
    arr = Range("A1").CurrentRegion
    For i = 2 To UBound(arr)
        d(arr(i, 1) & arr(i, 2) & arr(i, 3) & arr(i, 4)) = i
    Next
    t = d.items
    For i = 0 To d.Count - 1
        m = i + 2
        For j = 1 To 6
            arr(m, j) = arr(t(i), j)
        Next
    Next
    ActiveSheet.UsedRange.ClearContents
    Range("A1").Resize(m, 6) = arr
End Sub
或
Sub Macro2() '写到Sheet2
    Dim arr, t, d As Object, i&, j&, m&
    Set d = CreateObject("scripting.dictionary")
    arr = Range("A1").CurrentRegion
    For i = 2 To UBound(arr)
        d(arr(i, 1) & arr(i, 2) & arr(i, 3) & arr(i, 4)) = i
    Next
    t = d.items
    For i = 0 To d.Count - 1
        m = i + 2
        For j = 1 To 6
            arr(m, j) = arr(t(i), j)
        Next
    Next
    With Sheets("Sheet2")
        .UsedRange.ClearContents
        .Range("A1").Resize(m, 6) = arr
    End With
End Sub

YEJINHAI

可以了。谢谢。谢谢

YEJINHAI

YEJINHAI 发表于 2011-10-25 16:29
可以了。谢谢。谢谢

大家好，自定义列参与对比是否重复，重复行删除。
上次我按照版主的宏运行，简直是瞬间可得，完全正确。{:soso_e179:}
但这次我遇到了另外一个难题，我试着改一下版主的宏，运行，未果。
具体情况描述一下。
这次参与对比是否重复的列分别 C列，D列，E列，F列，I列。如果是重复了，删除最前的行，只保留最后一行。
A列，B列，G列，H列，J列，K列不参与对比。
这个宏又怎样写呢？
谢谢！

有附件，2个，源表B和效果表B。

YEJINHAI

zhaogang1960 发表于 2011-10-25 15:55
短信收到，请测试
Sub Macro1()
    Dim arr, t, d As Object, i&, j&, m&

版主你好！
自定义列参与对比是否重复，重复行删除。
上次我按照版主的宏运行，简直是瞬间可得，完全正确。{:soso_e179:}
但这次我遇到了另外一个难题，我试着改一下版主的宏，运行，未果。
具体情况描述一下。
这次参与对比是否重复的列分别 C列，D列，E列，F列，I列。如果是重复了，删除最前的行，只保留最后一行。
A列，B列，G列，H列，J列，K列不参与对比。
这个宏又怎样写呢？
谢谢！

有附件，2个，源表B和效果表B。

zhaogang1960

YEJINHAI 发表于 2011-10-27 12:31
版主你好！
自定义列参与对比是否重复，重复行删除。
上次我按照版主的宏运行，简直是瞬间可得，完全正 ...

源表B.rar (32.25 KB, 下载次数: 223)

2011-10-27 17:09 上传

点击文件名下载附件

YEJINHAI

zhaogang1960 发表于 2011-10-27 17:09

完全正确，真的！一个字“快”。