Удаление повторяющихся строк после проверки всех столбцов

Question

Я написал макрос ниже, чтобы удалить повторяющиеся строки после проверки всех столбцов. Я думал, что он работает правильно, основываясь на логике, но вывод неправильный, и некоторые из строк, которые должны отображаться, удаляются. Может ли кто-нибудь помочь мне в этом?

Перед тем, как этот макрос будет запущен, у меня есть еще один макрос для сортировки данных по нескольким столбцам, чтобы убедиться, что похожие строки сгруппированы вместе, поэтому, возможно, макрос может принять это во внимание и проверить только строку над ним, а не проверить все строки? Большое спасибо за любую помощь!

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 

Answer 1

Чтобы удалить дубликат, вы можете просто нажать кнопку «Удалить дубликат» в ленте данных> Инструменты данных.
Ниже демонстрационный:
У меня есть данные, как это в листе:

Я хотел бы иметь уникальные данные в столбце
нажмите кнопку «Удалить дубликаты» кнопка и после экрана запроса , и я снимите columnB

Нажмите на кнопку OK и есть окно с уведомлением о том, что мне 2 дублируется значение было удалить и 5 уникальное значение было найдено в следующем окне:

Ниже конечный результат:

Answer 2

использовать встроенную в RemoveDuplicates команду. Это будет намного быстрее, чем цикл через строки. Единственный трюк в поле - это передача массива для параметра columns.

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