Excel - 使用基于用户输入的日期填充列

时间:2013-08-04 12:45:23

标签: date loops excel-vba vba excel

我非常熟练使用Excel VBA(有很多在线帮助!!)但是我偶然发现了一个让我完全陷入困境的问题。

我正在为项目规划创建一个甘特图。我的问题是,我希望让用户指定项目开始日期和项目结束日期,然后让电子表格填充从开始日期到结束日期的列。

参见基本布局: enter image description here

我已经用输入框

取消了用户输入
Sub Set_Project_Start_Date()

' Written 2nd August 13
' P.J. Callaghan
'

ActiveSheet.Select
Dim projStartDate

showInputBox_Start:
projStartDate = Application.InputBox("Please enter Project Start Date" & Chr(10) & "Must be a Monday" & Chr(10) & "Format is: dd/mm/yyyy")

' Set Message Box such that clicking cancel ends the sub-routine for projStartdate variable
If projStartDate = False Then
MsgBox "You clicked the Cancel button, Input Box will close.", 64, "Cancel was clicked."
Exit Sub
ElseIf projStartDate = "" Then
MsgBox "You must click Cancel to exit.", 48, "You clicked Ok but entered nothing."
GoTo showInputBox_Start
Else
MsgBox "You entered " & projStartDate & ".", 64, "Please click OK to resume."
Range("c6").Select
With Selection
.Value = projStartDate
.NumberFormat = "dd-mmm-yy"
End With
Range("e10").Select
With Selection
.Value = projStartDate
.NumberFormat = "dd-mmm-yy"
.Orientation = 90
End With

End If

End Sub

Sub Set_Project_End_Date()

' Written 2nd August 13
' P.J. Callaghan
'

ActiveSheet.Select
Dim projEndDate

showInputBox_End:
projEndDate = Application.InputBox("Please enter Project End Date" & Chr(10) & "Must be a Monday" & Chr(10) & "Format is: dd/mm/yyyy")

' Set Message Box such that clicking cancel ends the sub-routine for projStartdate variable
If projEndDate = False Then
MsgBox "You clicked the Cancel button, Input Box will close.", 64, "Cancel was clicked."
Exit Sub
ElseIf projEndDate = "" Then
MsgBox "You must click Cancel to exit.", 48, "You clicked Ok but entered nothing."
GoTo showInputBox_End
Else
MsgBox "You entered " & projEndDate & ".", 64, "Please click OK to resume."
Range("c7").Select
With Selection
.Value = projEndDate
.NumberFormat = "dd-mmm-yy"
End With

End If

End Sub

我所困扰的是编写代码,仅从开始日期到结束日期填充。我确定这必须是某种循环安排......但我还没想到它。

我想知道你们中是否有人能提出解决方案?

提前致谢,

2 个答案:

答案 0 :(得分:1)

如果您的目标是填充以单元格E10开头的行,其中包含从项目的开始日期到结束日期的每日日期,那么您可以使用自动填充:

With Worksheets("Gantt")
    Set sourceRange = .Range("E10")
    sourceRange.Value = projStartDate
    Set fillRange = .Range(sourceRange, Cells(sourceRange.Row, _
        sourceRange.Column + projEndDate - projStartDate + 1))
    sourceRange.AutoFill Destination:=fillRange, Type:=xlFillDays
End With

答案 1 :(得分:0)

Chuff,这就是钱。

我已经把你的代码稍微修改了......出于某种原因它没有作为复制和粘贴执行

Sub Date_Fill()

' http://stackoverflow.com/questions/18043084/excel-populate-columns-with-dates-based-on-user-input

Dim projEndDate As Date
Dim projStartDate As Date
Dim projDuration As Integer

projStartDate = Range("c6").Value
projEndDate = Range("c7").Value

With Worksheets("Gantt")
    Set SourceRange = .Range("E10")
    SourceRange.Value = projStartDate
    Set fillRange = .Range(SourceRange, Cells(SourceRange.Row, _
        SourceRange.Column + projEndDate - projStartDate + 1))
    SourceRange.AutoFill Destination:=fillRange, Type:=xlFillDays
End With

End Sub

非常感谢你的帮助......这个问题已经困扰了我几个星期了。今天我正在研究循环,因为我认为答案可能就在那里。

再次......非常感谢。