vba - Excel VBA 运行时错误 '424' 删除行时需要对象

Question

我正在尝试比较 2 个工作表(Sheet1 和 Sheet2)之间的单元格值以查看它们是否匹配，如果它们匹配，请将 Sheet1 中的匹配值移动到预先存在的列表(Sheet3)并删除 Sheet1 中的值之后。

我在 Excel VBA 中使用反向 For 循环，但一切正常，直到我开始使用 newrange1.EntireRow.Delete 删除行。

这会在 VBA 中引发“424”对象必需错误，我花了几个小时试图解决这个问题，我不确定为什么会出现这种情况。我是否错误地选择了行？对象？

如果有人能指出我正确的方向，我将不胜感激。

这是我的代码:

Sub Step2()

    Sheets("Sheet1").Activate

    Dim counter As Long, unsubListCount As Long, z As Long, x As Long, startRow As Long
    counter = 0
    startRow = 2
    z = 0
    x = 0

    ' Count Sheet3 Entries
    unsubListCount = Worksheets("Sheet3").UsedRange.Rows.Count

    Dim rng1 As Range, rng2 As Range, cell1 As Range, cell2 As Range, newrange1 As Range

    ' Select all emails in Sheet1 and Sheet2 (exclude first row)
    Set rng1 = Worksheets("Sheet1").Range("D1:D" & Worksheets("Sheet1").UsedRange.Rows.Count)
    Set rng2 = Worksheets("Sheet2").Range("D1:D" & Worksheets("Sheet2").UsedRange.Rows.Count)

   ' Brute Loop through each Sheet1 row to check with Sheet2
    For z = rng1.Count To startRow Step -1
        'Cells(z, 4)
        Set cell1 = Worksheets("Sheet1").Cells(z, "D")
        For x = rng2.Count To startRow Step -1
            Set cell2 = Worksheets("Sheet2").Cells(x, "D")

            If cell1.Value = cell2.Value Then ' If rng1 and rng2 emails match
                counter = counter + 1
                Set newrange1 = Worksheets("Sheet1").Rows(cell1.Row)

                newrange1.Copy Destination:=Worksheets("Sheet3").Range("A" & unsubListCount + counter)
                newrange1.EntireRow.Delete
            End If
        Next
    Next
End Sub

这是我收到的错误:

Answer 1

您的内部循环会产生大量分步工作，使用 Application.Match 可以更好地完成这些工作。使用 .UsedRange 检索 D 列中值的范围最好是自下而上查找最后一个值。

Option Explicit

Sub Step2()

    Dim z As Long, startRow As Long
    Dim rng2 As Range, wk3 As Worksheet, chk As Variant

    startRow = 2
    z = 0
    Set wk3 = Worksheets("Sheet3")

    ' Select all emails in Sheet1 and Sheet2 (exclude first row)
    With Worksheets("Sheet2")
        Set rng2 = .Range(.Cells(2, "D"), .Cells(.Rows.Count, "D").End(xlUp))
    End With

    With Worksheets("Sheet1")
        For z = .Cells(.Rows.Count, "D").End(xlUp).Row To startRow Step -1
            chk = Application.Match(.Cells(z, "D").Value2, rng2, 0)
            If Not IsError(chk) Then
                .Cells(z, "A").EntireRow.Copy _
                    Destination:=wk3.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
                .Cells(z, "A").EntireRow.Delete
            End If
        Next
    End With
End Sub

正如 Ryan Wildry 所指出的，您最初的问题是在删除行后继续循环并进行比较。可以通过在 newrange1.EntireRow.Delete 之后添加 Exit For 来避免这种情况，以便在找到匹配项后跳出内部循环。我认为您不应该“重置 cell1”，因为这可能会扰乱循环迭代。