Question

注意：其中一位用户提出了这个问题，在我回答后他将其删除。我只是将问题和答案重新发布，因为我认为这是一个糟糕的编码习惯的好例子，并强调了为什么需要使用Option Explicit

我有一个工作表更改事件，如果更改工作表“current”上的第I列，则会将当前行剪切/粘贴到“已完成”工作表中。唯一的问题是我需要从表格中删除空行。我当前的代码只是导致它清除行，而不是删除/移位它。如何在不影响更改事件的情况下删除行并向上移动？

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim KeyCells As Range
    Dim LastRowCompleted As Long
    Dim RowToDelete As Long
    RowToDelete = 0
    LastRowCompleted = Sheets("completed").Cells(Sheets("completed").Rows.Count, "A").End(xlUp).Row
    LastRowCompleted = LastRowCompleted + 1 'Next row after last row
    Set KeyCells = Range("I:I")
    Application.EnableEvents = False

    If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then

        'Cut and Paste Row
        Target.EntireRow.Cut Sheets("completed").Range(LastRowCompleted & ":" & LastRowCompleted)
        'Mark to delete row
        RowToDelete = Target.EntireRow.Row
    End If
    Application.EnableEvents = True

    Call DeleteRow(RowToDelete)

End Sub

Sub DeleteRow(Row As Long)
    If RowsToDelete > 0 Then
        Rows(Row).EntireRow.Delete Shift:=xlToUp
    End If
End Sub

Answer 1

始终使用Option Explicit

没有任何名为xlToUp的正确枚举值为xlUp

这是错误的

Sub DeleteRow(Row As Long)
    If RowsToDelete > 0 Then
        Rows(Row).EntireRow.Delete Shift:=xlToUp
    End If
End Sub

没有RowsToDelete变量，因此您的条件总是评估为false。

正确的代码将是

Sub DeleteRow(RowsToDelete As Long)
    If RowsToDelete > 0 Then
        Rows(RowsToDelete).EntireRow.Delete Shift:=xlUp
    End If
End Sub

删除行后启用事件，否则您将陷入无限循环。

 Call DeleteRow(RowToDelete)
 Application.EnableEvents = True

剪切或复制后始终设置CutCopyMode=False

这样可行。

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim KeyCells As Range
    Dim LastRowCompleted As Long
    Dim RowToDelete As Long
    RowToDelete = 0
    LastRowCompleted = Sheets("completed").Cells(Sheets("completed").Rows.Count, "A").End(xlUp).Row
    LastRowCompleted = LastRowCompleted + 1 'Next row after last row
    Set KeyCells = Range("I:I")
    Application.EnableEvents = False

    If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then

        'Cut and Paste Row
        Target.EntireRow.Cut Sheets("completed").Range(LastRowCompleted & ":" & LastRowCompleted)
        Application.CutCopyMode = False
        'Mark to delete row
        RowToDelete = Target.EntireRow.Row
    End If


    Call DeleteRow(RowToDelete)
    Application.EnableEvents = True


End Sub

Sub DeleteRow(RowsToDelete As Long)
    If RowsToDelete > 0 Then
        Rows(RowsToDelete).EntireRow.Delete Shift:=xlUp
    End If
End Sub

在工作表上删除并移动单元格会更改

1 个答案: