Question

我有以下Excel问题：

我目前在sheet1列A，B，C中有这个：

日期工作人员
04/04/2016 4,5 John 05/04/2016 2约翰
2016年6月6日6,5约翰 07/04/2016 0 -
08/04/2016 0,5查尔斯
08/04/2016 2约翰
08/04/2016 0,5 William
09/04/2016 0 -
10/04/2016 0 -
11/04/2016 9约翰
11/04/2016 3,75 William

我在表3中也有：
项目的创建日期在单元格E1：28/03/2016
项目的实际开始在单元格F1中：2016年3月29日今天的日期在单元格G1中（让我们考虑今天的日期是我接下来要展示的那个）：2016年4月13日

在sheet2中我想要的是什么：

选择项目创建和实际开始之间的最早日期，在本例中为28/03/2016 然后使用0时间和 - 工人添加缺少的日期，直到它到达今天的日期完成后应该看起来像这样：

日期工作人员
2016/03/28 0 -
2016/03/29 0 -
2016/03/30 0 -
2016/03/31 0 -
01/04/2016 0 -
02/04/2016 0 -
03/04/2016 0 -
04/04/2016 4,5 John 05/04/2016 2约翰
2016年6月6日6,5约翰 07/04/2016 0 -
08/04/2016 0,5查尔斯
08/04/2016 2约翰
08/04/2016 0,5 William
09/04/2016 0 -
10/04/2016 0 -
11/04/2016 9约翰
11/04/2016 3,75 William
2016年4月12日0 -
2016年4月13日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

时间轴 - 填写表格，其中包含给定间隔

2 个答案: