Insert Rows based on DateDiff

问题

I have a spreadsheet that I use to track my classes. I need to set it up for export into a calendar. I have all my classes listed with begin and end dates. I want to be able to insert rows below each listed class using the date difference as the number of rows and then copy the information to those rows with the respective dates.

I have the following code which inserts the rows, but then gives me a '1004' error.

Public Sub Format()
    Dim i As Long
    Dim d As Long

    LastRow = Worksheets("GCalExport").UsedRange.Rows.Count

    For i = 2 To LastRow
        d = DateDiff("d", Cells(i, "B"), Cells(i, "D"))
        Cells(i, 1).Offset(1).Resize(d).EntireRow.Insert
    Next i
End Sub

回答1:

You are getting this error because either column B or column D (possibly both) do not contain a date and the DateDiff fails.

This happens when you insert a couple of rows and then just move to the next row. Of course, the newly inserted row is empty and does not contain a date in column B or column D (and the above error occurs).

So, you need to adjust your code as follows:

Public Sub Format()

Dim i As Long
Dim d As Long
Dim LastRow As Long

With Worksheets("GCalExport")
    LastRow = .UsedRange.Rows.Count
    i = 2

    While i <= LastRow
        'Check if column B and column D actually contain a date
        If IsDate(.Cells(i, "B")) And IsDate(.Cells(i, "D")) Then
            d = DateDiff("d", .Cells(i, "B"), .Cells(i, "D"))
            .Cells(i, 1).Offset(1).Resize(d).EntireRow.Insert
            'Since you inserted d rows the next row to check is
            '  row i + d
            i = i + d
            '  furthermore the last row just got increased by
            '  d as well
            LastRow = LastRow + d
            'Move to the next row for processing
            i = i + 1
        Else
            'If column B and / or D do not contain a valid date then
            '  ignore that row and go to the next row.
            i = i + 1
        End If
    Wend
End With

End Sub

Note the comments for more information.

来源：https://stackoverflow.com/questions/36556073/insert-rows-based-on-datediff

标签

excel

vba

excel-vba

datediff