基于DateDiff插入行（填入带日期的插入行）

Question

我正在使用this thread中的宏来插入新行

但问题是当开始日期与结束日期相同时我会得到

  

错误1004

• 您可以帮助修改VBA以跳过那些产生错误的行吗？
• 是否有一种简单的方法可以填写B栏（标记为红色）完成表格的相应日期（每行一天）？

Start Date  End Date    Hours   Type
02-01-18    02-01-18    8   one day
04-01-18    04-01-18    4   half day
05-01-18    06-01-18    16  multiple days
07-01-18    10-01-18    16  multiple days
11-01-18    11-01-18    8   one day

更新

Answer 1

您可以使用if命令检查日期是否匹配，然后只检查它们是否不匹配。代码现在将添加开始和结束日期之间的每个后续日期

Public Sub AAA_Format()

Dim i As Long
Dim d As Long
Dim LastRow As Long
Dim j As Long
Dim rng As Range, rng2 As Range
Dim startrow As Long, insertedrow As Long
Application.CutCopyMode = False

With Worksheets("Data")
    LastRow = .UsedRange.Rows.Count


    For i = LastRow To 2 Step -1 '' starts at bottom and goes up, that way inserting rows doesn impact it
        'checks to see if 2 values are the same
        If Not Cells(i, "B") = Cells(i, "C") Then
        Debug.Print Cells(i, "B")
        Debug.Print Cells(i, "C")

            d = DateDiff("d", .Cells(i, "B"), .Cells(i, "C")) '' find differene
             Debug.Print d
              insertedrow = i + d
            .Rows(i + 1 & ":" & insertedrow).Insert Shift:=xlDown
        End If

        For j = 1 To d
            .Cells(i + j, 2) = .Cells((i + j) - 1, 2) + 1
            .Cells(i + j, 3) = "what ever you want to calc end date as"
            .Cells(i + j, 4) = "what ever you want to calc hours as"
            .Cells(i + j, 5) = "what ever you want to calc day as"
        Next j

    Next i

End With

End Sub

要插入列，您可以使用

ActiveSheet.Range("D:D").EntireColumn.Insert

并为其添加公式，您可以使用

LastRow = ActiveSheet.Range("B" & ActiveSheet.Rows.Count).End(xlUp).Row '' this find bottom row by starting on very last row of sheet and moving up until it finds a cell with a value in it
Range("D2").Formula = "=IF(C2>0,C2,C1+1)"'' you might need to change , for ; depending on your language pack
Range("D2:D" & LastRow ).FillDown