vba - 运行时 440 Excel 错误删除 VBA 中的选定行

Question

编辑:所以我尝试手动执行此代码中的操作，并且 excel 也崩溃了。这是否意味着我遇到了与其他海报相同的崩溃错误？

作为序言，公平的警告我不是一个专业的程序员，我只是玩这个来试图让我(和我的同事)的生活更轻松一些。

这段代码在我一个月前制作时正在运行，也许它被更新破坏了，不确定，但我不确定为什么它现在会抛出错误。我拥有的另一个非常相似的宏仍然有效。

现在宏 抛出 错误 440 ，然后，MS Excel 将崩溃。

Sub RemoveRow()
    Dim Eng As Worksheet
    Dim rmg As Range
    Dim Sup As Worksheet

    Application.ScreenUpdating = False

       '~~> Set this to the relevant worksheet
    Set Eng = ThisWorkbook.Sheets("Engr+Tech")
    Set Sup = ThisWorkbook.Sheets("Suprv+Sppt")

    Eng.Activate

With Eng

    Range("D8").End(xlDown).Select

    '~~> Set your range
    Set rmg = .Rows(ActiveCell.Row)

    '~~> Delete the range
    rmg.Delete

    '~~> Select last row
    Set rmg = .Rows(ActiveCell.Row)
    rmg.Offset(-1).Select

    '~~> Select techs
    Cells(Selection.Row, 4).End(xlDown).Select
    Cells(Selection.Row, 4).End(xlDown).Select

     '~~> Set your range
    Set rmg = .Rows(ActiveCell.Row)

    '~~> Delete the range
    rmg.Delete

    '~~> Select last row
    Set rmg = .Rows(ActiveCell.Row)
    rmg.Offset(-1).Select

    '~~> Select ftechs
    Cells(Selection.Row, 4).End(xlDown).Select
    Cells(Selection.Row, 4).End(xlDown).Select

     '~~> Set your range
    Set rmg = .Rows(ActiveCell.Row)

    '~~> Delete the range
    rmg.Delete

End With

Sup.Activate

With Sup

    Range("D8").End(xlDown).Select

    '~~> Select CLS
    Cells(Selection.Row, 4).End(xlDown).Select
    Cells(Selection.Row, 4).End(xlDown).Select

     '~~> Set your range
     '~~> Set rmg = .Rows(ActiveCell.Row)

    '~~> Delete the range
    .Rows(ActiveCell.Row).Delete

End With

Eng.Activate

Range("A1").Select

Application.ScreenUpdating = True


End Sub

Answer 1

尝试不使用所有选择/激活

Sub RemoveRow()

    Dim Eng As Worksheet
    Dim rmg As Range
    Dim Sup As Worksheet

    Application.ScreenUpdating = False

    '~~> Set this to the relevant worksheet
    Set Eng = ThisWorkbook.Sheets("Engr+Tech")
    Set Sup = ThisWorkbook.Sheets("Suprv+Sppt")

    '>> avoiding deleting the cell referenced by rmg...
    Set rmg = Eng.Range("D8").End(xlDown).Offset(-1, 0)
    rmg.Offset(1, 0).EntireRow.Delete

    Set rmg = rmg.End(xlDown).End(xlDown).Offset(-1, 0)
    rmg.Offset(1, 0).EntireRow.Delete

    Set rmg = rmg.End(xlDown).End(xlDown).Offset(-1, 0)
    rmg.Offset(1, 0).EntireRow.Delete

    Sup.Range("D8").End(xlDown).End(xlDown).End(xlDown).EntireRow.Delete

    Eng.Activate
    Eng.Range("A1").Select

    Application.ScreenUpdating = True

End Sub