Удалить дубликаты на основе 2 столбцов в ObjectList - PullRequest
0 голосов
/ 13 июня 2019

Я хочу удалить дублированные значения в моей таблице. Это ListObject Table с тысячами строк. Я не могу заставить работать свой код, и я использую функцию RemoveDuplicates для диапазонов с условием удаления строк в таблице, если есть дубликаты в 2 относительных столбцах.

Вот как это выглядит перед запуском кода:

enter image description here

В моем коде, основанном только на столбцах C: C и E: E, мне нужно проверить, есть ли в каждой строке дубликаты в этих 2 столбцах, и удалить их, оставив только один.

И это мой желаемый результат:

enter image description here

Это мой код, который не работает. Я не уверен, что это потому, что моя таблица является объектом списка или я неправильно назначил массив?

Sub test_Duplicate()
  Dim endrow As Long
  Dim rng As Range
  Dim ws As Worksheet
  Set ws = Sheets("Sheet4")

      With ws
        endrow = .Cells(.Rows.Count, 3).End(xlUp).Row
        Set rng = .Range(.Cells(2, 3), .Cells(endrow, 6))
        rng.RemoveDuplicates Columns:=Array(1, 3), Header:=xlNo
    End With


End Sub

Буду признателен за любую помощь. Я заметил, что независимо от того, находятся ли мои данные в таблице как объект списка или без них, я все равно получаю ошибку с номером 9.

Ответы [ 2 ]

0 голосов
/ 13 июня 2019

Вот лучшее решение, которое мне удалось найти, просматривая веб-страницы.

Sub RemoveDuplicates()
Const TEST_COLUMN As String = "A"
Dim i As Long
Dim iLastRow As Long
Dim rng As Range
Dim ws As Worksheet
Set ws = Worksheets("Sheet4")

With ws
    iLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
    For i = 1 To iLastRow
    If .Evaluate("SUMPRODUCT(--(A" & i & ":A" & iLastRow & "=A" & i & ")," & _
    "--(I" & i & ":I" & iLastRow & "=I" & i & "))") > 1 Then
    If rng Is Nothing Then
    Set rng = .Cells(i, "A").Resize(, 9)
    Else
    Set rng = Union(rng, .Cells(i, "A").Resize(, 9))
    End If
    End If
    Next i

If Not rng Is Nothing Then rng.Delete

End With

 End Sub
0 голосов
/ 13 июня 2019

Это будет работать:

Просто измените TableName ..Mine is Table1

Sub test_Duplicate()

  Dim ws As Worksheet
  Set ws = Sheets("Sheet4")

    With ws
        .Range("Table1[#All]").RemoveDuplicates Columns:=Array(1, 3), Header:=xlYes
    End With


End Sub

Имя таблицы находится на вкладке Design при выборе таблицы.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...