VBA自动添加持续时间以开始日期以生成结束日期

Question

我试图根据表格的开始日期和持续时间生成我的结束日期。我的桌子如下：

id的表列，任务desc，开始日期，持续时间，计划的结束日期分别为a，b，c，d，e

我尝试按以下方式运行VBA代码，但它只会在我运行子运行时生成结束日期。我如何将其作为自动生成？代码如下：

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

，尽管我建议您仅在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

请注意，除非删除 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

每次您在列以列开始日期或持续时间输入数据时都会生成输出。