1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
| Option Explicit
Option Base 1
Public Function NETWORKDAYSMISC(ByVal lStartDate As Long, _
ByVal lEndDate As Long, _
ByVal rgeHolidays As Range, _
ByVal rgeWorkDays As Range) As Long
Dim iweekdaycount As Integer
Dim bhasvalidworkday As Boolean
Dim bisvalidworkday As Boolean
Dim lnewdate As Long
Dim arholidays() As Long
Dim iholidaycount As Integer
Dim iarrayno As Integer
Dim ldaycount As Long
Call Application.Volatile(True)
If lStartDate = lEndDate Then NETWORKDAYSMISC = 0
If lStartDate = lEndDate Then Exit Function
bhasvalidworkday = False
For iweekdaycount = 1 To 7 Step 1
If rgeWorkDays.Item(iweekdaycount).Text <> "" Then
bhasvalidworkday = True
Exit For
End If
Next iweekdaycount
If bhasvalidworkday = False Then Call MsgBox("The rgeWorkDays parameter is incorrect")
If bhasvalidworkday = False Then Exit Function
ReDim arholidays(rgeHolidays.Count)
For iholidaycount = 1 To rgeHolidays.Count
If rgeHolidays.Item(iholidaycount).Value <> "" Then
arholidays(iholidaycount) = rgeHolidays.Item(iholidaycount).Value
Else
Exit For
End If
Next iholidaycount
ReDim Preserve arholidays(iholidaycount - 1)
lnewdate = lStartDate
ldaycount = 0
Do Until lnewdate = lEndDate
bisvalidworkday = True
If lStartDate < lEndDate Then lnewdate = lnewdate + 1
If lStartDate > lEndDate Then lnewdate = lnewdate - 1
If rgeWorkDays.Item(VBA.Weekday(lnewdate)).Text <> "" Then
For iarrayno = 1 To UBound(arholidays)
If lnewdate = arholidays(iarrayno) Then
bisvalidworkday = False
Exit For
End If
Next iarrayno
If bisvalidworkday = True Then
If (lStartDate - lEndDate) < 0 Then ldaycount = ldaycount + 1
If (lStartDate - lEndDate) > 0 Then ldaycount = ldaycount - 1
End If
End If
Loop
NETWORKDAYSMISC = ldaycount
End Function
|
