Timeline - перебрать все даты между первым и последним данным и добавить дату в столбце, если не найден

Question

, что у меня есть в столбцах A, B, C:

Дата Часы Наименование
01/03/2016 8,0 Джон
02/03/2016 8,0 Джон
08/03/2016 7,5 Джон
08/03/2016 2,0 Чарльз
08/03/2016 2,0 Уильям
10/03/2016 3,5 Чарльз
11/03/2016 3,7 Чарльз
14/03/2016 2,2 Charles
15/03/2016 Джон
8,0 16/03/2016 8,0 Джон

что я хочу в колонке А, В, С в другом листе:

Дата Часы Наименование
01/03/2016 Джон
8,0 02/03/2016 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 -
08/03/2016 7,5 Джон
08/03/2016 2,0 Чарльз
08/03/2016 2,0 Уильям
09/03/2016 0,0 -
10/03/2016 3,5 Чарльз
11/03/2016 3,7 Чарльз
12/03/2016 0,0 -
13/03/2016 0,0 -
14/03/2016 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 После :