☰

如果在另一个工作表中发现重复项，则删除 Excel 工作表中的行

tag-icon • tag-icon microsoft-excel worksheet-function vba microsoft-excel-2016
如果在另一个工作表中发现重复项，则删除 Excel 工作表中的行

我有两个工作表：“compiled”和“firstpickup”。如果 A 列中的值也可以在“compiled”的 A 列中找到，则我希望删除工作表“firstpickup”中的行。“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

相关内容