VBA计算周末的天数

我正在寻找方法来计算使用VBA 在两个date之间的周末(周六和周日)的天数

我已经通过networkingsearch,但都显示如何计算工作日(有些使用DateDiff,有些使用networking日),但周末没有天,我已经成功地在工作日做这个。

例如:

从2015年3月10日至2015年10月9日,应该返回2天(周六和周日,不是5天(周一,周二,周三,当天,周五)。

<<<更新2/11/2015 >>>

我试图根据@ R3uK风格改变代码,但答案是“怪异的”,我不明白为什么结果可能是这样的。 这里的代码:

Sub DateWeekDiff() Sheets("Duplicate Removed").Activate Dim Date1 As Date, Date2 As Date, StartDate As Date, EndDate As Date Dim WeekendDays As Long, CountWeekendDays As Long, i As Long Dim lrow As Long Dim PRow As Long Dim CurrentSheet As Worksheet Set CurrentSheet = Excel.ActiveSheet FRow = CurrentSheet.UsedRange.Cells(1).Row lrow = CurrentSheet.UsedRange.Rows(CurrentSheet.UsedRange.Rows.count).Row WeekendDays = 0 For PRow = lrow To 2 Step -1 'If CurrentSheet.Cells(PRow, "AD").Value <> "" And CurrentSheet.Cells(PRow, "T").Value <> "" Then _ ' CurrentSheet.Cells(PRow, "AP").Value = Abs(DateDiff("d", (CurrentSheet.Cells(PRow, "AD").Value), (CurrentSheet.Cells(PRow, "T").Value))) For i = 0 To DateDiff("d", CurrentSheet.Cells(PRow, "AD").Value, CurrentSheet.Cells(PRow, "T").Value) Select Case Weekday(DateAdd("d", i, CurrentSheet.Cells(PRow, "AD").Value)) Case 1, 7 WeekendDays = WeekendDays + 1 End Select Next i CountWeekendDays = WeekendDays CurrentSheet.Cells(PRow, "AL").Value = CountWeekendDays Next PRow End Sub 

结果(例如)AD = 26/1/2015 5:00:00 PM和T = 13/1/2015 8:05:00 AM等于AL = 807878.循环也非常缓慢(不响应而)。

这个函数应该可以做到这一点:

 Public Function CountWeekendDays(Date1 As Date, Date2 As Date) As Long Dim StartDate As Date, EndDate As Date, _ WeekendDays As Long, i As Long If Date1 > Date2 Then StartDate = Date2 EndDate = Date1 Else StartDate = Date1 EndDate = Date2 End If WeekendDays = 0 For i = 0 To DateDiff("d", StartDate, EndDate) Select Case Weekday(DateAdd("d", i, StartDate)) Case 1, 7 WeekendDays = WeekendDays + 1 End Select Next i CountWeekendDays = WeekendDays End Function 

因为它是一个Public Function ,所以在将它放入任何模块之后,可以直接在Excel中使用它=CountWeekendDays(A1,B1)或者像这样在你的循环中:

 For i = 2 to 50 variable = CountWeekendDays(Cells(i, "AD"), Cells(i, "T")) next i 

这是你的整个小组从无用的东西:

 Sub DateWeekDiff() Dim FRow As Long, Lrow As Long, PRow As Long Dim CurrentSheet As Worksheet Set CurrentSheet = Excel.Sheets("Duplicate Removed") With CurrentSheet FRow = .UsedRange.Cells(1).Row Lrow = .Range("A" & .Rows.Count).End(xlUp).Row For PRow = Lrow To 2 Step -1 .Cells(PRow, "AL").Value = _ CountWeekendDays(.Cells(PRow, "AD").Value, .Cells(PRow, "T").Value) Next PRow End With End Sub 

所以你只需要粘贴在我的post开始的function,你可以使用它,就像我上面做的,或直接在Excel中(这是为单元格AL2) =CountWeekendDays(AD2,T2)

我的函数版本计算周末天数:

 Public Function CountWeekendDays(Date1 As Date, Date2 As Date) As Long Dim weekDifference As Integer Dim weekday1 As Byte Dim weekday2 As Byte '------------------------------------------------------------------ weekDifference = VBA.DateDiff("w", Date1, Date2) weekday1 = VBA.Weekday(Date1, vbMonday) weekday2 = VBA.Weekday(Date2, vbMonday) CountWeekendDays2 = VBA.Abs(VBA.DateDiff("w", Date1, Date2) * 2) If Date1 < Date2 Then CountWeekendDays2 = CountWeekendDays2 + VBA.IIf(weekday1 < 6, 2, 8 - weekday1) + _ VBA.IIf(weekday2 < 6, 0, weekday2 - 5) If weekday2 >= weekday1 Then CountWeekendDays2 = CountWeekendDays2 - 2 Else CountWeekendDays2 = CountWeekendDays2 + VBA.IIf(weekday2 < 6, 2, 8 - weekday2) + _ VBA.IIf(weekday1 < 6, 0, weekday1 - 5) If weekday1 >= weekday2 Then CountWeekendDays2 = CountWeekendDays2 - 2 End If End Function 

这个函数只使用算术运算,所以比使用循环的函数要快得多。

芯片皮尔森在这里有一个相当不错的解决scheme

你可以像这样使用它:

 days = NetWorkdays2(StartDate, EndDate As Date, 62) '62 is all days except weekends, (2+4+8+16+32) 

他还提出了一个公式,可以直接写入一个单元格,没有VBA。