☰

如果在另一個工作表中發現重複行，則刪除 Excel 工作表中的行

tag-icon • tag-icon microsoft-excel worksheet-function vba microsoft-excel-2016
如果在另一個工作表中發現重複行，則刪除 Excel 工作表中的行

我有兩個工作表：「compiled」和「firstpickup」。我想要做的是刪除工作表「firstpickup」中的行，如果 A 列中的值也可以在「compiled」的 A 列中找到。 「compiled」是 42,000 行，「firstpickup」是 21,000 行，所以我希望能夠運行巨集並在檢查完所有資料後結束它。

以下是我根據粗略的谷歌搜尋嘗試過的一些選項：

 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

相關內容