Добавить новую строку в таблицу Excel, если условие соответствует

Question

У меня есть таблица Excel, в которую я хотел бы добавить новую строку, если условие соответствует.На самом деле мой код работает частично.Он добавляет строки, но когда работа заканчивается, появляется отладка (ошибка времени выполнения 13, несоответствие типов).У меня проблемы, если иногда происходит непредвиденная ошибка.Поэтому, пожалуйста, помогите мне улучшить мой код и работать правильно.

Sub AddWorkingYearLine2()

    Dim i As Long

    With Worksheets("DB")
        For i = Cells(Rows.Count, "A").End(xlUp).Row To 4 Step -1
            'make sure it's not an "old entry"
            If Cells(i, "A").Value2 <> Cells(i + 1, "A").Value2 Then
                'if today occurs after "end date" then
                If Range("D1") > CDate(Cells(i, "F").Value) And Len(Cells(i, "F").Value2) > 0 Then
                    'insert row
                    Rows(i + 1).Insert Shift:=xlShiftDown

                    'copy row down
                    'Rows(i + 1).Value = Rows(i).Value

                    'update dates
                    Cells(i + 1, "A").Value = Cells(i, "A").Value
                    Cells(i + 1, "B").Value = Cells(i, "B").Value
                    Cells(i + 1, "C").Value = Cells(i, "C").Value
                    Cells(i + 1, "D").Value = Cells(i, "D").Value
                    Cells(i + 1, "E").Value = Cells(i, "F").Value
                    Cells(i + 1, "F").Value = DateAdd("yyyy", 1, CDate(Cells(i + 1, "E").Value))
                    Cells(i + 1, "G").Value = Cells(i, "M").Value
                    Cells(i + 1, "H").Value = Cells(i, "H").Value
                    Cells(i + 1, "I").Value = Cells(i, "I").Value
                    Cells(i + 1, "J").Value = Cells(i, "J").Value

                    Application.CutCopyMode = False

                End If
            End If
        Next i
    End With
End Sub

Answer 1

вы используете With Worksheets("DB"), но тогда вы не ссылаетесь на все объекты диапазона на Worksheets("DB") объект, так как вы не используете точки ...

Dim i As Long

With Worksheets("DB")
    For i = .Cells(.Rows.Count, "A").End(xlUp).Row To 4 Step -1
        'make sure it's not an "old entry"
        If .Cells(i, "A").Value2 <> .Cells(i + 1, "A").Value2 Then
            'if today occurs after "end date" then
            If .Range("D1") > CDate(.Cells(i, "F").Value) And Len(.Cells(i, "F").Value2) > 0 Then
                'insert row
                .Rows(i + 1).Insert Shift:=xlShiftDown

                'copy row down
                'Rows(i + 1).Value = Rows(i).Value

                'update dates
                .Cells(i + 1, "A").Value = .Cells(i, "A").Value
                .Cells(i + 1, "B").Value = .Cells(i, "B").Value
                .Cells(i + 1, "C").Value = .Cells(i, "C").Value
                .Cells(i + 1, "D").Value = .Cells(i, "D").Value
                .Cells(i + 1, "E").Value = .Cells(i, "F").Value
                .Cells(i + 1, "F").Value = DateAdd("yyyy", 1, CDate(.Cells(i + 1, "E").Value))
                .Cells(i + 1, "G").Value = .Cells(i, "M").Value
                .Cells(i + 1, "H").Value = .Cells(i, "H").Value
                .Cells(i + 1, "I").Value = .Cells(i, "I").Value
                .Cells(i + 1, "J").Value = .Cells(i, "J").Value

                Application.CutCopyMode = False

            End If
        End If
    Next

End With