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

注意：其中一位用户提问此问题，我回答后删除了它。我只是重新发布的问题和答案在我看来，它为什么一个需要使用Option Explicit在工作表上删除并移动单元格更改

我有一个工作表更改事件坏的编码习惯和亮点的一个很好的例子，如果在表列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

来源

2017-06-12 cyboashu

始终使用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

来源

2017-06-12 18:43:49 cyboashu

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

回答

相关问题