VBA自动添加开始date以产生结束date

我正在尝试根据表中的开始date和持续时间生成结束date。 我的表格如下：

ID，Task Desc，Start Date，Duration，Planned End Date的表格列分别是A，B，C，D，E

我试图运行VBA代码如下，但它只会生成结束date，当我运行的子。 我如何使它成为自动生成？ 代码如下：

Sub PlannedEndDate() Dim userInputDate As Date Dim duration As Integer Dim endDate As Date Dim MyRow As Long 'Start at row 6 MyRow = 6 'Loop untill column A is empty (no task) While Cells(MyRow, "A").Value <> "" 'Only if not yet filled in. If Cells(MyRow, "E").Value = "" Then 'Fetch info userInputDate = Cells(MyRow, "C").Value duration = Cells(MyRow, "D").Value endDate = DateAdd("d", duration, userInputDate) 'Put it back on the sheet Cells(MyRow, "E").Value = endDate End If MyRow = MyRow + 1 Wend End Sub 

非常感谢。

Answer 1

尽pipe我build议你只使用列E中的公式（例如E6将有=IF(OR(C6="",D6=""),"",C6+D6) ），下面的Worksheet_Change事件可能做你已经要求了。

 Private Sub Worksheet_Change(ByVal Target As Range) Dim c As Range Dim o As Integer Application.EnableEvents = False 'Don't do anything unless something changed in columns C or D If Not Intersect(Target, Columns("C:D")) Is Nothing Then 'Process all changed cells in columns C and D For Each c In Intersect(Target, Columns("C:D")) With c 'Ensure that we are on row 6 or later, and 'column E is empty, and 'neither column C or column D is empty If .Row > 5 And _ IsEmpty(Cells(.Row, "E").Value) And _ Not (IsEmpty(Cells(.Row, "C").Value) Or IsEmpty(Cells(.Row, "D").Value)) Then 'Ensure that column C contains a date, and 'column D contains a numeric value If IsDate(Cells(.Row, "C").Value) And _ IsNumeric(Cells(.Row, "D").Value) Then 'Calculate planned end date Cells(.Row, "E").Value = CDate(Cells(.Row, "C").Value + Cells(.Row, "D").Value) End If End If End With Next End If Application.EnableEvents = True End Sub 

请注意，更改C或D列中的单元格将不会重新计算E列中的值，除非您删除了说明IsEmpty(Cells(.Row, "E").Value) And _ 。 （但是，如果你这样做，你可以用我推荐的公式。）

Answer 2

我认为你的数据如下所示

 ID Task Description Start Date Duration Planned End Date 1 subtask1 5-Dec-16 5 2 subtask2 22-Dec-16 6 3 subtask3 1-Dec-16 33 4 subtask4 21-Dec-16 12 5 subtask5 4-Jan-16 6 

将下面的代码放在要执行操作的工作表模块中

 Private Sub Worksheet_Change(ByVal Target As Range) If (Target.Column = 3 Or Target.Column = 4) And Target.Row >= 2 Then If Cells(Target.Row, 3) = vbNullString Or Cells(Target.Row, 4) = vbNullString Then Else Cells(Target.Row, 5).Value = Cells(Target.Row, 3).Value + Cells(Target.Row, 4).Value End If End If End Sub 

每当您在列开始date或持续时间中input数据时，它会生成输出。