如果在Excel中找到区分大小写的重复项(对于100k或更多记录),如何删除整行?

时间:2017-04-03 16:44:36

标签: excel vba excel-vba excel-formula excel-2016

这是来自How to remove duplicates that are case SENSITIVE in Excel (for 100k records or more)? 的后续问题。

由于他的代码程序仅操纵A列的数据,如果找到区分大小写的重复,我还想删除整行数据。< / p>

  

区分大小写的含义:

     
      
  1. 案例1
  2.   
  3. 情形1
  4.   
  5. 案例1
  6.         

    是否都是唯一记录。

1 个答案:

答案 0 :(得分:5)

您可以使用Dictionary检查二进制唯一性和变体数组,以加快速度。要使用字典,您需要包含对 Microsoft Scripting Runtime Library 的引用

(工具&gt;参考资料&gt; Microsoft Scripting Runtime库)

我已经在我的笔记本电脑上测试了100,000行,平均 0.25秒

Sub RemoveDuplicateRows()
    Dim data As Range
    Set data = ThisWorkbook.Worksheets("Sheet1").UsedRange

    Dim v As Variant, tags As Variant
    v = data
    ReDim tags(1 To UBound(v), 1 To 1)
    tags(1, 1) = 0 'keep the header

    Dim dict As Dictionary
    Set dict = New Dictionary
    dict.CompareMode = BinaryCompare

    Dim i As Long
    For i = LBound(v, 1) To UBound(v, 1)
        With dict
            If Not .Exists(v(i, 1)) Then 'v(i,1) comparing the values in the first column 
                tags(i, 1) = i
                .Add Key:=v(i, 1), Item:=vbNullString
            End If
        End With
    Next i

    Dim rngTags As Range
    Set rngTags = data.Columns(data.Columns.count + 1)
    rngTags.Value = tags

    Union(data, rngTags).Sort key1:=rngTags, Orientation:=xlTopToBottom, Header:=xlYes

    Dim count As Long
    count = rngTags.End(xlDown).Row

    rngTags.EntireColumn.Delete
    data.Resize(UBound(v, 1) - count + 1).Offset(count).EntireRow.Delete
End Sub

基于this question

的精彩答案