允許在工作表事件事件中插入

Question

我創建了一個工作表更改事件，如果列I被更改（添加了日期），它會將其插入到新工作表並將其刪除。

但是，無論何時插入一行，它都會自動將該行插入到其他工作表中，然後將其刪除。我怎樣才能防止它，所以只要單元格有一個值以便我可以插入，它只會執行工作表更改事件？

我認爲我可以通過檢查ActiveCell.Value <> ""來進一步嵌套IF語句，但是單元格被關閉時會發生變化。

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") 


    If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then 
    Application.EnableEvents = False 
     'Cut and Paste Row 
     Target.EntireRow.Copy Sheets("completed").Range(LastRowCompleted & ":" & LastRowCompleted) 
     'Mark to delete row 
     RowToDelete = Target.EntireRow.Row 

    Call DeleteRow(RowToDelete) 
    Application.EnableEvents = True 

    End If 



End Sub 

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

Answer 1

事情是這樣的：

Private Sub Worksheet_Change(ByVal Target As Range) 

    Dim KeyCells As Range 

    Set KeyCells = Application.Intersect(Range("I:I"), Target) 

    If Not KeyCells Is Nothing Then 
     If KeyCells.Cells.Count > 1 Then Exit Sub '<<<<<<< 
     If KeyCells.Value <> "" Then 
      Application.EnableEvents = False 
      With Target.EntireRow 
       .Copy Sheets("completed").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) 
       .Delete 
      End With 
      Application.EnableEvents = True 
     End If 
    End If 

End Sub 

注意有可能爲用戶一次更改多個行，但您的代碼不處理：如果您嘗試比較多小區範圍內的值到一個會引發運行時錯誤的單個值（因爲您試圖將一個數組與一個值進行比較）