时间轴 - 遍历第一个和最后一个给定日期之间的所有日期，如果未找到则将日期添加到列

Question

我在 A、B、C 列中的内容：

日期时间名称
2016 年 1 月 3 日 8,0 约翰
2016 年 2 月 3 日 8,0 约翰
2016 年 8 月 3 日 7,5 约翰
2016 年 8 月 3 日 2,0 查尔斯
2016 年 8 月 3 日 2,0 威廉
2016 年 10 月 3 日 3,5 查尔斯
2016 年 11 月 3 日 3,7 查尔斯
2016 年 3 月 14 日 2,2 查尔斯
15/03/2016 8,0 约翰
16/03/2016 8,0 约翰

我想要在另一张表的 A、B、C 列中显示的内容：

日期时间名称
2016 年 1 月 3 日 8,0 约翰
2016 年 2 月 3 日 8,0 约翰
03/03/2016 0,0 -
04/03/2016 0,0 -
05/03/2016 0,0 -
06/03/2016 0,0 -
07/03/2016 0,0 -
2016 年 8 月 3 日 7,5 约翰
2016 年 8 月 3 日 2,0 查尔斯
2016 年 8 月 3 日 2,0 威廉
09/03/2016 0,0 -
2016 年 10 月 3 日 3,5 查尔斯
2016 年 11 月 3 日 3,7 查尔斯
2016 年 12 月 3 日 0,0 -
13/03/2016 0,0 -
2016 年 3 月 14 日 2,2 查尔斯
15/03/2016 8,0 约翰
16/03/2016 8,0 约翰

它必须适用于任何给定的日期、时间和名称！

请帮助我真的需要这个！

Sub proj0()

Dim lRow As Long

Dim Data1, Data2 As Date
Dim C1, C2 As String

Folha11.Select

    Columns("a:c").Select
    Selection.Copy

  Folha13.Select

    Range("A1").Select
    ActiveSheet.Paste

    Cells.Select
    Selection.Sort _
        Key1:=Range("a2"), Order1:=xlAscending, _
        key2:=Range("c2"), Order2:=xlAscending, _
        Header:=xlYes, OrderCustom:=1, _
        MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal

    lRow = 2

    Do While (Cells(lRow, 1) <> "")


        C1 = Cells(lRow, "c")
        C2 = Cells(lRow + 1, "c")

        Data1 = Cells(lRow, "a")
        Data2 = Cells(lRow + 1, "a")


        If (Data2 - Data1 > 1) Then
        ActiveCell.EntireRow.Insert shift:=xlDown

       Cells(lRow + 1, "a").Value = Data1 + 1
        Cells(lRow + 1, "b").Value = 0
        Cells(lRow + 1, "c").Value = "-"
           Else
            lRow = lRow + 1
        End If
    Loop
 Range("a:c").Columns.AutoFit
 Folha13.Select

我相信我很接近但无法确定插入部分

Answer 1

这符合您的建议：

Sub timeline()

Dim i As Long
Dim ws As Worksheet
Dim ts As Worksheet

Set ws = Sheets("Sheet15") 'Change to your Output Sheet
Set ts = Sheets("Sheet14") 'Change to your data sheet

With ws
    i = ts.Range("A" & ts.Rows.Count).End(xlUp).Row
    ts.Range("A1:C" & i).Copy .Range("A1")
    .Range("A1:C" & i).Sort Key1:=.Range("A2"), Order1:=xlAscending, _
        key2:=.Range("C2"), Order2:=xlAscending, _
        Header:=xlYes
    Do Until i = 2
        If .Cells(i, 1).Value2 = .Cells(i - 1, 1).Value2 Or .Cells(i, 1).Value2 = .Cells(i - 1, 1).Value2 + 1 Then
            i = i - 1
        Else
            .Rows(i).Insert
            .Cells(i, 1).Value = .Cells(i + 1, 1).Value2 - 1
            .Cells(i, 2).Value = 0#
            .Cells(i, 3).Value = "--"
        End If
    Loop
End With

End Sub

Sheet14 之前：

Sheet15 之后：