Удалить всю строку на основе дубликатов в столбце Y и сохранить последнюю запись - PullRequest
Новая
       9

Удалить всю строку на основе дубликатов в столбце Y и сохранить последнюю запись

0 голосов
/ 18 сентября 2018

Я работаю с набором данных, который обновляется после завершения опроса общего ресурса, а затем ответы на этот опрос экспортируются в таблицу в Excel.Я хочу иметь возможность удалить всю строку (и), если почтовый индекс (строка) проверенного объекта (столбец Y) совпадает, но я хочу сохранить самый последний ответ на опрос или тот, который отображается вболее высокое значение строки.

Например, строка 38 содержит ответ на опрос со строкой почтового индекса «33138.»Строка 52 (опрос завершен совсем недавно), также был завершен для почтового индекса "33138."Я хочу удалить строку 38 и сохранить строку 52.

Ищу решение VBA.

@ BigBen Я пробовал этот код, который я нашел на нескольких форумах.Также обратите внимание, что я планирую запустить это с помощью кнопки на вкладке «Панель инструментов» для записей на вкладке «данные». 

Sub deduplicate()
Dim Rng As Range, Dn As Range, n As Long
Dim Lst As Long, nRng As Range
Lst = Range("Y" & Rows.Count).End(xlUp).Row
    With CreateObject("scripting.dictionary")
        .CompareMode = vbTextCompare
For n = Lst To 1 Step -1
    If Not .Exists(Range("Y" & n).Value) Then
        .Add Range("Y" & n).Value, Nothing
    Else
        If nRng Is Nothing Then
            Set nRng = Range("Y" & n)
        Else
            Set nRng = Union(nRng, Range("Y" & n))
        End If
End If
Next n
If Not nRng Is Nothing Then nRng.EntireRow.Delete
End With
End Sub

@ BigBen, в рамках более длинного сценария я также попробовал следующий код.Это работало, но удаляло только первый экземпляр дубликата, а не все дубликаты строк. 

Worksheets("Data").Activate
Dim lrow As Long

For lrow = Cells(Rows.Count, "Y").End(xlUp).Row To 2 Step -1
    If Cells(lrow, "Y") = Cells(lrow, "Y").Offset(-1, 0) Then
       Cells(lrow, "Y").Offset(-1, 0).EntireRow.Delete
    End If

Next lrow

1 Ответ

0 голосов
/ 18 сентября 2018

Исходя из вашего комментария о том, что данные находятся в таблице (ListObject), что-то подобное может сработать.Это переходит от первой к последней строке, удаляя строку, если CountIf в столбце, используя значение текущей строки, больше 1. 

Sub DedupeZipCodes()
    Dim tbl As ListObject: Set tbl = ThisWorkbook.Sheets("Data").ListObjects("Table1")
    Dim zipCol As ListColumn: Set zipCol = tbl.ListColumns("Zip Code")
    Dim currentRow As Long, lastRow As Long

    With zipCol
        currentRow = 1
        lastRow = .DataBodyRange.Rows.Count

        Do While currentRow < lastRow
            If Application.CountIf(.DataBodyRange, .DataBodyRange(currentRow).Value) > 1 Then
                .DataBodyRange(currentRow).EntireRow.Delete
                lastRow = .DataBodyRange.Rows.Count
            Else
                currentRow = currentRow + 1
            End If
        Loop

    End With
End Sub
...