☰

Удаление строк на листе Excel, если на другом листе найдены дубликаты

tag-icon • tag-icon microsoft-excel worksheet-function vba microsoft-excel-2016
Удаление строк на листе Excel, если на другом листе найдены дубликаты

У меня есть два листа: "compiled" и "firstpickup". Я хочу удалить строки на листе "firstpickup", если значение в столбце A также можно найти в столбце A "compiled". "compiled" содержит 42 000 строк, а "firstpickup" — 21 000, поэтому я хотел бы иметь возможность просто запустить макрос и завершить его после обработки всех данных.

Вот несколько вариантов, которые я попробовал на основе беглого поиска в Google:

 Sub RemoveDuplicates()
    Dim rCrit As Range 'Range To Search For Duplicates
    Dim rFilt As Range 'Range To Remove Duplicates
    Dim lLoop As Long

    Set rCrit = Worksheets("compiled").Range("A1", Worksheets("compiled").Range("A" & Rows.Count).End(xlUp))
    Set rFilt = Worksheets("firstpickup").Range("A1", Worksheets("firstpickup").Range("A" & Rows.Count).End(xlUp))

    For lLoop = rCrit.Rows.Count To 2 Step -1
        If WorksheetFunction.CountIf(rCrit, rFilt(lLoop).Value) > 0 Then
            Worksheets("firstpickup").Rows(lLoop).Delete shift:=xlUp
        End If
    Next lLoop
End Sub

Эта подпрограмма не находила совпадений в функции «if», поэтому она не удаляла ни одной строки, даже те строки, о которых я знал, что они дублируются.

Sub Removeduplicates()

Dim Row As Long
Dim FoundDup As Range

Sheets("compiled").Select

For Row = Range("A24031").End(xlUp).Row To 2 Step -1

Set FoundDup = Sheets("compiled").Range("A:A").Find(Cells(Row, 1), LookIn:=xlValues, lookat:=xlWhole)

If Not FoundDup Is Nothing Then
    Cells(Row, 1).EntireRow.Delete
End If

Next Row

End Sub

Эта подпрограмма также не была успешной; после запроса «For» отладчик перешел к «end sub».

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

решение1

Вы можете использовать этот код VBA, он поможет вам удалить строки из листа Firstpickup,если значения в столбце A будут совпадать со значениями в столбце Aиз Complied Sheet.

Sub DeleRows()
Dim LR As Long, i As Long
With Sheets("Firstpickup")
LR = .Range("A" & Rows.Count).End(xlUp).Row
For i = LR To 1 Step -1
    If IsNumeric(Application.Match(.Range("A" & i).Value, Sheets("Complied").Columns("A"), 0)) Then .Rows(i).Delete
Next i
End With
End Sub

Связанный контент