根据开始和结束date的不同，自动填充多个条目到日历

我正在尝试编写一个VBA在汇总表中查找date，并将数据填充到员工度假跟踪的日历中。

“摘要”页面中的数据如下所示

月员工度假types开始date结束date时间二月卡尔半日午餐2/26/2015 2/26/2015
2月Hurness半日下午2015年2月26日2/26/2015
Feb Edna半天上午1/18/2016 2/26/2015

我写了下面的代码来填充单行。 我想知道如何根据开始和结束date的不同来填充多个条目到日历

提前感谢任何帮助！

Sub AddToCalendar（）

Dim R As Range Dim lastRow As Long Dim startDate As Integer Dim Employee As String Dim Reason As String Dim Time As String Dim sSheet As String 'locate the info in the last row of the Summary sheet lastRow = Sheets("Summary").Cells(Rows.Count, 4).End(xlUp).row Employee = Sheets("Summary").Cells(lastRow, 2).Value Reason = Sheets("Summary").Cells(lastRow, 3).Value Time = Sheets("Summary").Cells(lastRow, 6).Value 'active the worksheet of relevant month sSheet = Sheets("Summary").Cells(lastRow, 1).Value Worksheets(sSheet).Activate 'locate the cell of specific date and enter data startDate = Day(Sheets("Summary").Cells(lastRow, 4).Value) endDate = Day(Sheets("Summary").Cells(lastRow, 5).Value) With Sheets(sSheet) If startDate = endDate Then Set R = .Range("A1:H58").Find(startDate) If Not R Is Nothing Then Sheets(sSheet).Cells(R.row + 1, R.Column).Value = Employee & " " & Reason & " " & Time End If Else Do Until startDate = endDate startDate = startDate + 1 Set R = .Range("A1:H58").Find(startDate) If Not R Is Nothing Then Sheets(sSheet).Cells(R.row + 1, R.Column).Value = Employee & " " & Reason & " " & Time End If Loop End If End With 

结束小组

Answer 1

要根据date范围（不同的开始date和结束date）在汇总表中input多行，最好的方法是首先确定员工rest了多less天。 这是一个相当简单的算术计算，例如：

TotalDaysOff = EndDate - StartDate + 1

[注意：我们必须在公式中加1以获得正确的天数。 例如2/26/2015 – 2 / 26-2015将等于0，但我们知道它实际上是1]。

一旦我们计算了TotalDaysOff ，我们可以创build一个简单的循环来填充每一行，例如：

 If TotalDaysOff = 1 then With Sheets(sSheet) Set R = .Range("A1:H58").Find(startDate) If Not R Is Nothing Then Sheets(sSheet).Cells(R.row + 1, R.Column).Value = Employee & " " & Reason & " " & Time End If End With Else for i = 1 to TotalDaysOff With Sheets(sSheet) Set R = .Range("A1:H58").Find(startDate + (i - 1)) If Not R Is Nothing Then Sheets(sSheet).Cells(R.row + 1, R.Column).Value = Employee & " " & Reason & " " & Time End If End With Next i End If 

这对你有用吗？

Answer 2

我试图添加代码来跳过周末，但是我对这里的逻辑有些不满。 这是我所做的，你可以看一下，看看有什么不对吗？ 非常感谢！

  For i = 1 To TotalDaysOff With Sheets(sSheet) Set R = .Range("A1:H58").Find(startDate + (i - 2)) If Not R Is Nothing Then Sheets(sSheet).Cells(R.row + 1, R.Column).Value = Employee & " " & Reason & " " & Time If skipWeekend >= 6 Then Sheets(sSheet).Cells(R.row + 1, R.Column).Value = "" Else Sheets(sSheet).Cells(R.row + 1, R.Column).Value = Employee & " " & Reason & " " & Time End If End If