首页 > 解决方案 > 如果条件满足,则在 Excel 表中添加新行

问题描述

我有一个 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

标签: excelvba

解决方案


您正在使用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

推荐阅读