Timeline - заполнить лист с недостающими датами между заданным интервалом

Question

Я следующую задачу Excel:

Я в настоящее время имеют это в Лист1 столбцах A, B, C:

Дата Время Worker
04/04/2016 4,5 Джон
05/04/2016 2 John
06/04/2016 6,5 Джон
07/04/2016 0 -
08/04/2016 0,5 Чарльз
08/04/2016 2 John
08/04/2016 0,5 Уильям
09/04/2016 0 -
10/04/2016 0 -
11/04/2016 9 John
11/04/2016 3.75 Уильям

у меня также есть в листе 3:
дата создания проекта в ячейке E1: 28/03/2016
Фактическое начало проекта в ячейке F1: 29/03/2016
дата, Сегодня В ячейке G1 (давайте рассмотрим сегодня дату, которую я покажу в следующем): 13/04/2016

То, что я хочу в sheet2:

Выберите самую раннюю дату между Созданием и фактическим началом проекта, который в данном случае является 28/03/2016
Затем добавьте пропущенные даты с 0 Временем и - работник до него достигает сегодняшней даты.
Он должен выглядеть следующим образом после того, как все сделано:

Дата Время Worker
28/03/2016 0 -
29/03/2016 0 -
30/03/2016 0 -
31/03/2016 0 -
01/04/2016 0 -
02/04/2016 0 -
03/04/2016 0 -
04/04/2016 4,5 Джон
05/04/2016 2 John
06/04/2016 6,5 John
07/04/2016 0 -
08/04/2016 0,5 Чарльз
08/04/2016 2 John
08/04/2016 0,5 Уильям
09/04/2016 0 -
10/04/2016 0 -
11/04/2016 9 John
11/04/2016 3.75 William
12/04/2016 0 -
13/04/2016 0 -

Это продолжение проблемы, которую я только что обнаружил сейчас:
Timeline - loop through all dates between first and last given and add date to column if not found Ищете решение макроса excel-vba, потому что я считаю, что это единственный способ сделать это.
Я новичок в VBA и застрял в этой проблеме, и вся помощь мне очень помогает!

Отредактировано, чтобы сказать следующее: ячейки, в которых даты создания, фактическое начало проекта и сегодня не имеют большого значения, могут быть на любом листе.Просто сказал, что для примера. Надеюсь, предоставленная ссылка поможет вам помочь!

Answer 1

вы можете использовать такое же решение, предложенное @ScottCraner, просто изменив несколько строк

Sub timeline() 

Dim i As Integer 
Dim ws As Worksheet 
Dim ts As Worksheet 
Dim startDate as Date 

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

' get the earliest day 
startDate = cdate(application.WorksheetFunction.Min(cdate(ts.range("E1")),cdate(ts.range("E2")))) 

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 .cells(i,1).value2 = startDate ' fill all dates 'til startDate 
     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 

Answer 2

Этот ответ работал для меня. Я немного использовал код @kellsens и получил ответ сам!

Sub macro6() 
Application.ScreenUpdating = False 
Dim i As Long 
Dim ws As Worksheet 
Dim ts As Worksheet 
Dim fs As Worksheet 
Dim startDate As Date 
Dim todaydate As Date 

Folha13.Select 

Set ws = Sheets("sheet1") 'Change to your Output Sheet 
Set ts = Sheets("sheet2") 'Change to your data sheet 
Set fs = Sheets("sheet3") 'Change to your data sheet 
sheet2.Range("a1:c250").ClearContents 

' get the earliest day 
startDate = CDate(Application.WorksheetFunction.Min(CDate(fs.Range("b6")), CDate(fs.Range("b7")))) 
todaydate = CDate(fs.Range("b10")) 
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 

     i = 2 
     If .Cells(i, 1).Value2 <> startDate Then 
      .Rows(i).Insert 
      .Cells(i, 1).Value = startDate 
      .Cells(i, 2).Value = 0# 
      .Cells(i, 3).Value = "--" 

    End If 

    i = ts.Range("A" & ts.Rows.Count).End(xlUp).Row + 1 
      If .Cells(i, 1).Value2 <> todaydate Then 
      .Rows(i + 1).Insert 
      .Cells(i + 1, 1).Value = todaydate 
      .Cells(i + 1, 2).Value = 0# 
      .Cells(i + 1, 3).Value = "--" 

    End If 

     i = ts.Range("A" & ts.Rows.Count).End(xlUp).Row + 2 

    Do Until .Cells(i, 1).Value2 = startDate ' fill all dates 'til startDate 


      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 
Application.ScreenUpdating = True 
End Sub