用VBA計算兩個日期之間的工作日(去掉周末兩天)

最近公司HR和Finance想算員工的工作天數，想讓我幫忙寫些VBA，自己從網上找了下代碼，自己再改改，以下來自網絡。

計算兩個日期之間的工作日，用VBA，因量大，最好用數組做

Sub kk()
Dim arr, i&, j&, m&
arr = Sheet2.Range("b3:f4")
For i = 1 To UBound(arr)
    m = 0
    For j = arr(i, 1) To arr(i, 3)
       If Weekday(j) <> 1 And Weekday(j) <> 7 Then m = m + 1
    Next
    arr(i, 5) = m
Next
Sheet2.Range("b3").Resize(UBound(arr), 5) = arr
End Sub

根據他提供的方法，其實就是判斷某個日期是星期一到星期五就日期計數加1，一直到結束，自己改良了下：

Sub m1()
For i = 2 To 5000
    days = 0
    
    If Range("b" & i) <> "" And Range("c" & i) <> "" Then
        
        Dim d1, d2 As Date
        d1 = Cells(i, "b")
        d2 = Cells(i, "c")
        
        Do While d1 <= d2
        If Weekday(d1, vbMonday) < 6 Then
            days = days + 1
        End If
            d1 = DateAdd("d", 1, d1)
        Loop
        
        Range("d" & i) = days
        
    End If
Next
End Sub

上面的這個方法只算是可以運行，如果計算的天數多並且員工數多，則效果就差了，所以又有了下面的改良。

計算兩個日期的整周數，然后乘5，在加上前后不夠整周的零頭。

Sub m2()
For i = 2 To 5000
    If Range("b" & i) <> "" And Range("c" & i) <> "" Then
        Dim d1, d2 As Date
        d1 = Cells(i, "b")
        d2 = Cells(i, "c")
        days1 = 0
        days2 = 0
        weekcount = 0
        
        Do While Weekday(d1, vbMonday) < 7 And d1 <= d2
        If Weekday(d1, vbMonday) < 6 Then
            days1 = days1 + 1
        End If
            d1 = DateAdd("d", 1, d1)
        Loop
        
        weekcount = DateDiff("w", d1, d2, vbMonday)
        days2 = Weekday(d2, vbMonday)
        days2 = IIf(days2 = 6, 5, IIf(days2 = 7, 0, days2))
        Range("d" & i) = IIf(d1 >= d2, days1, days1 + 5 * weekcount + days2)
        
    End If
Next

End Sub

以上代碼可以通過測試驗證效率，如下代碼

Sub Button2_Click()
    d1 = Timer
    m1
    'm2
    d2 = Timer
    MsgBox d2 - d1
End Sub

 

參考出處：http://www.excelpx.com/thread-299850-1-1.html