Welcome to OStack Knowledge Sharing Community for programmer and developer-Open, Learning and Share
Welcome To Ask or Share your Answers For Others

Categories

0 votes
1.0k views
in Technique[技术] by (71.8m points)

vba - How to delete entire row when case sensitive duplicates are found in Excel (for 100k records or more)?

This is a follow up question from How to remove duplicates that are case SENSITIVE in Excel (for 100k records or more)? .

Since his code procedure manipulates the data of column A only, I'd like to also delete the entire row of data if case-sensitive duplicate is found.

Case sensitive meaning:

  1. Case1
  2. case1
  3. cASE1

Are all unique records.

See Question&Answers more detail:os

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome To Ask or Share your Answers For Others

1 Answer

0 votes
by (71.8m points)

You can use a Dictionary to check for binary uniqueness and variant arrays to speed things up. To use the dictionary you will need to include a reference to Microsoft Scripting Runtime Library

(Tools > References > Microsoft Scripting Runtime library)

I've tested this with 100,000 rows which takes on average 0.25 seconds on my laptop.

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

Based on the brilliant answer from this question


与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome to OStack Knowledge Sharing Community for programmer and developer-Open, Learning and Share
Click Here to Ask a Question

...