Removing duplicate rows after checking all columns

不羁岁月 提交于 2019-12-25 16:24:11

问题


I have written the below macro to remove duplicate rows after checking all columns. I thought it was working correctly, based on the logic, but the output is not correct, and a few of the rows that should be showing up are being deleted. Can anyone help me with that?

Before this macro is run, i have another macro to sort the data by a few columns to ensure that similar rows are grouped together, so maybe the macro can take that into account, and check only the row above it instead of checking all the rows? Greatly appreciate any help!

Sub Delete_Repeated_Rows()
Dim Rng As Range
Dim ColumnCounter As Integer

Set Rng = ActiveSheet.UsedRange.Rows

'Using ColumnCounter to hold total number of cells that match. If all of them match, delete row'

 For r = Rng.Rows.Count To 1 Step -1
    ColumnCounter = 0
    For Col = Rng.Columns.Count To 1 Step -1 'Loop through columns and find matches'
        If Application.WorksheetFunction.CountIf(Rng.Columns(Col), Rng.Cells(r, Col)) > 1 Then
            ColumnCounter = ColumnCounter + 1
        End If
    Next Col

    If ColumnCounter = Rng.Columns.Count Then
        Rng.Rows(r).EntireRow.Delete
    End If
Next r
End Sub

回答1:


To delete the duplicate you can just click the "Remove duplicate" button at Data Ribbon > Data Tools.


Following is the demo:
I have the data like this in the worksheet:


I would like to have unique data at column A
click the "Remove duplicate" button and following screen prompted out and i uncheck columnB


Click the OK button and there is a notification box telling me that 2 duplicated value been remove and 5 unique value were found as following screen:


The following is the end result:




回答2:


use the built-in RemoveDuplicates command. It will be a lot faster than looping through rows. The only trick in the box is passing the array for the columns parameter.

Sub DeDupe()
    Dim intArray As Variant, i As Integer
    Dim rng As Range
    Set rng = ActiveSheet.UsedRange.Rows
    With rng
        ReDim intArray(0 To .Columns.Count - 1)
        For i = 0 To UBound(intArray)
            intArray(i) = i + 1
        Next i
        .RemoveDuplicates Columns:=(intArray), Header:=xlYes
    End With
End Sub


来源:https://stackoverflow.com/questions/30904786/removing-duplicate-rows-after-checking-all-columns

易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!