Попытка переместить строку на другой лист, если дата введена в Excel

Question

Я использую приведенный ниже код, и он перемещает строку при вводе записей без даты. Если я ввожу текст, он перемещает строку. Я только хочу, чтобы это переместилось, если есть дата в этом. Неважно, какая дата, но это должна быть дата.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column = 2 And Target.Cells.Count = 1 Then
        If Target.Value > Date - 10000 Then
            With Target.EntireRow
                .Copy Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
                .Delete
            End With
        End If
    End If
End Sub

Answer 1

Вот некоторые улучшения в вашем коде:

1. Даже если вы можете сделать это всего за одну строку, я добавил кратные IFs и Exit Sub, если условия не выполняются (просто делает код более читабельный IMO)
2. Используйте объекты для манипулирования данными, когда это возможно, например, установите ссылку на целевой лист и повторно используйте ее в своем коде
3. Полная квалификация объектов (например, Rows.Count должно быть targetSheet.Rows.Count)

Код:

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim targetSheet As Worksheet

    Set targetSheet = ThisWorkbook.Worksheets("Sheet2")

    ' Check if is in column "B" and just one cell
    If Target.Column = 2 And Target.Cells.CountLarge = 1 Then Exit Sub

    ' Check if is date
    If IsDate(Target.Value) = False Then Exit Sub

    ' Check if is greater than current date - 10000 days
    If Target.Value <= (Date - 10000) Then Exit Sub

    ' Copy and delete row
    With Target.EntireRow
        ' Use full qualifying of objects (for example, Rows.Count should be targetSheet.Rows.Count)
        .Copy targetSheet.Range("A" & targetSheet.Rows.Count).End(xlUp).Offset(1, 0)
        .Delete
    End With

End Sub

Дайте мне знать, если это работает