Translate

2011年3月31日木曜日

networkdays

ちゃんと動くか確認していないんだけど、
2000では、分析ツールをいれない限りつかえないNETWORKDAYSの代用コードを書いてみた。
あとで検証する。
Function NETWORKDAY(開始日 As Date, 終了日 As Date, Optional 祭日 As Range)
    Dim 日数 As Integer: 日数 = DateDiff("d", 開始日, 終了日) + 1
    Dim 休日 As Integer: 休日 = Int(日数 / 7) * 2
    Dim temp As Integer: temp = 日数 Mod 7
    
    If temp = 1 Then
        If (Weekday(終了日) = 1 Or Weekday(終了日) = 7) Then 休日 = 休日 + 1
    ElseIf temp = 2 Then
        If (Weekday(終了日) = 7 Or Weekday(終了日) = 2) Then 休日 = 休日 + 1
        If (Weekday(終了日) = 1) Then 休日 = 休日 + 2
    ElseIf temp = 3 Then
        If (Weekday(終了日) = 7 Or Weekday(終了日) = 3) Then 休日 = 休日 + 1
        If (Weekday(終了日) < 3) Then 休日 = 休日 + 2
    ElseIf temp = 4 Then
        If (Weekday(終了日) = 7 Or Weekday(終了日) = 4) Then 休日 = 休日 + 1
        If (Weekday(終了日) < 4) Then 休日 = 休日 + 2
    ElseIf temp = 5 Then
        If (Weekday(終了日) = 7 Or Weekday(終了日) = 5) Then 休日 = 休日 + 1
        If (Weekday(終了日) < 5) Then 休日 = 休日 + 2
    ElseIf temp = 6 Then
        If (Weekday(終了日) = 7 Or Weekday(終了日) = 6) Then 休日 = 休日 + 1
        If (Weekday(終了日) < 6) Then 休日 = 休日 + 2
    End If
    
    Dim i As Integer
    For i = 1 To 祭日.Count
        If 開始日 <= 祭日(i) And 祭日(i) <= 終了日 Then
            If Weekday(祭日(i)) <> 1 And Weekday(祭日(i)) <> 7 Then
                休日 = 休日 + 1
            End If
        End If
    Next

    NETWORKDAY = 日数 - 休日
End Function

Sub Auto_Open()
    Application.MacroOptions Macro:="NETWORKDAY", _
                Description:="開始日と終了日の間にある週の日数を計算します。"
End Sub

0 件のコメント: