Question

我有一个Excel表，如果条件满足，我想在其中添加新行。实际上，我的代码部分起作用。它添加了行，但是在工作完成时出现了Debug（运行时错误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

如果满足条件，则将新行添加到Excel表中

1 个答案: