VBA计算周末天数 [英] VBA Calculate Number of Days in Weekend

问题描述

我正在搜索使用VBA计算两个日期之间的周末（周六和周日）天数的方法。

I'm searching for ways to calculate number of days in weekend (Saturday and Sunday) between two dates using VBA.

我通过网络搜索，但都显示如何计算工作日（有些使用DateDiff，有些使用网络日），但周末没有几天，我已经成功的工作日。

I've searched through webs but all shows how to calculate working days (some use DateDiff, some use Networkdays) but there's no for days in weekend, and I'm already success to do this for working days.

示例：

从3/10/2015至9/10/2015从3月1日起，应返回2天（星期六和星期日， 5天（周一，周二，周三，周日，周五）。

From date 3/10/2015 to 9/10/2015, it should return 2 days (Saturday and Sunday, not 5 days(Monday, Tuesday, Wednesday, Thusday, Friday).

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

<<< Update 2/11/2015 >>>

我尝试根据@ R3uK风格改变代码，但答案是奇怪的，我不明白为什么结果可以这样，这里的代码：

I try to change the code according to @R3uK style, but the answers are 'weird' and I don't understand why the result can be like that. Here' the code :

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.
循环也很慢（不响应一段时间）。

The result turns (as example) AD = 26/1/2015 5:00:00 PM and T = 13/1/2015 8:05:00 AM equal to AL = 807878. The looping also very slow (Not Responding for a while).

推荐答案

这个功能应该是诀窍：

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

由于它是一个公共功能，在将其放入任何模块后，可以直接在Excel中使用它，如 = CountWeekendDays（A1，B1）或您的循环如下：

AS it is a Public Function, after putting it into any module, you can use it directly in Excel like this =CountWeekendDays(A1,B1) or in your loop like this :

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

这是你的整个sub从无用的东西策划：

And here is your whole sub curated from useless stuff :

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

所以你只需要在我的帖子开始粘贴这个功能，你可以像上面那样使用它，或者直接在Excel中（这是单元格AL2） = CountWeekendDays（AD2，T2）

So you just have to paste the function at the start of my post and after you can use it like I did right above, or directly in Excel (this is for the cell AL2) =CountWeekendDays(AD2,T2)

这篇关于VBA计算周末天数的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！