Einfügungen in Worksheet_change-Ereignis zulassen

Question

Ich habe ein Änderungsereignis für Arbeitsblätter erstellt. Wenn die Spalte I geändert wird (Datum hinzugefügt), wird sie in ein neues Blatt eingefügt und gelöscht.

Immer wenn ich jedoch eine Zeile einfüge, wird diese Zeile automatisch übernommen und in das andere Blatt eingefügt und dann gelöscht. Wie kann ich es verhindern, so dass es nur ein Arbeitsblattänderungsereignis tut, solange die Zelle einen Wert hat, damit ich einfügen kann?

Ich dachte, dass ich die IF-Anweisung ein bisschen weiter verschachteln könnte, indem Sie ActiveCell.Value <> "" überprüfen, aber das ändert sich, wenn die Zelle angeklickt wird.

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

Etwas wie folgt aus:

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 

Hinweis ist es möglich, dass ein Benutzer auf einmal mehrere Zeilen zu ändern, aber der Code nicht verarbeitet, dass: wenn Sie versuchen, eine Multizellenbereich des Wert vergleichen auf einen einzelnen Wert, der einen Laufzeitfehler verursacht (weil Sie versuchen, ein Array mit einem einzelnen Wert zu vergleichen)