ロゴ(青) Excel/VBA Tips ロゴ(緑)

Tips04: アドイン無しで営業日計算

  ここでは、分析ツールやkt関数アドイン等のアドインを使わずに、営業日算出/営業日数計算の
方法を解説します ( マクロでユーザー定義関数を作る場合は こちら )。
(注) ここに紹介するのは、無理にでも一般機能だけでやろうと思えば「出来ない事も無い」という程度のものです。
      『土日+祝日+α』ならば、迷わずに分析ツール(WORKDAY , NETWORKDATS)を使いましょう。
      『土日 固定』でない場合(隔週土曜休み等)には、kt関数アドイン(kt営業日算出 , kt営業日数)を使って
      下さい。会社規則でフリーのアドインが禁止されている場合には、【祝日ロジック】を参考にして各自のブック
      にマクロ(ユーザー定義関数)を作ってください。「フリーのアドインも駄目、マクロも駄目」という場合には下記
      の方法で凌いでください。


先ず、下記のような営業日カレンダーを作成します。

   (A) (B) (C) (D) (E)
( 1) 2003/ 1/ 1    1 1
( 2) 2003/ 1/ 2    2 2
( 3) 2003/ 1/ 3    3 3
( 4) 2003/ 1/ 4 * 3   
( 5) 2003/ 1/ 5 * 3   
( 6) 2003/ 1/ 6    4 4
( 7) 2003/ 1/ 7    5 5
( 8) 2003/ 1/ 8    6 6
( 9) 2003/ 1/ 9    7 7
(10) 2003/ 1/10    8 8
(11) 2003/ 1/11    9 9
(12) 2003/ 1/12 * 9   
(13) 2003/ 1/13    10 10
(14) 2003/ 1/14    11 11
(15) 2003/ 1/15    12 12
(16) 2003/ 1/16    13 13
(17) 2003/ 1/17    14 14
(18) 2003/ 1/18 * 14   
(19) 2003/ 1/19 * 14   
(20) 2003/ 1/20    15 15
  :   
(364) 2003/12/30      
(365) 2003/12/31      
(366) 2004/ 1/ 1         

式の簡素化の為に「1年366日」としてカレンダーの範囲を定めます
  ・2003年(平年)の1年分のみならば[A1〜A366]で[A366: 2004/1/1]
  ・2004年(閏年)の1年分のみならば[A1〜A366]で[A366: 2004/12/31]
  ・2002〜2003年の2年分ならば[A1〜A732]で
      [A730: 2003/12/31, A731: 2004/1/1, A732: 2004/1/2]
  ・2003〜2004年の2年分ならば[A1〜A732]で
      [A730: 2004/12/30, A731: 2004/12/31, A732: 2005/1/1]
これにより、式中の「$E$1:$E$366」といったカレンダー範囲が平年/閏年に係わり無く常に
一定します。

---- A列【日付】-----
指定した「年」に対して自動生成
[A1] =DATE(, 1, 1)
[A2] =A1+1
[A3] =A2+1
  :
[A366] = A365+1

---- B列【曜日】-----
[B1] =TEXT(A1, "aaa")
  :
[B366] =TEXT(A366, "aaa")

---- C列【休業日マーク】----
『手入力』で"*"を入力
(祝日や曜日など自動で決定できる部分は自動化する例をサンプルブックに載せてあります)

---- D列【通算営業日数】-----
[D1] =IF(C1<>"*", 1, 0)
[D2] =IF(C2<>"*", D1+1, D1)
[D3] =IF(C3<>"*", D2+1, D2)
  :
[D366] =IF(C366<>"*", D365+1, D365)

---- E列【検索用営業日数】-----
営業日のみD列の通算営業日数をコピー
[E1] =IF(C1<>"*", D1, "")
[E2] =IF(C2<>"*", D2, "")
  :
[E366] =IF(C366<>"*", D366, "")

======= 営業日算出式=====================================

(1) D列から、基準日の通算営業日数を求めます。
    [G3] =OFFSET($D$1, 基準日-$A$1, 0)

(2) 基準日に対する通算営業日数から、指定の営業日数を加減算し、求めるべき日付の
    通算営業日数を算出します。
    営業日数が負で、基準日が休業日の場合には(+1)の補正をします。
    [G4] =IF(日数>=0, G3+日数, IF(OFFSET($C$1, 基準日-$A$1, 0)="*", G3+日数+1, G3+日数))
        または
         =G3+日数+IF(日数<0, IF(OFFSET($C$1, 基準日-$A$1, 0)="*",1, 0), 0)

(3) 求めた通算営業日数をキーにしてE列を検索し、その位置(オフセット値)を求めます
    [G5] =MATCH(G4, $E$1:$E$366, 0)

(4) 求めたオフセット値を使ってA列から日付を取得します。これが答えとなる営業日の日付です。
    [G6] =OFFSET($A$1, G5-1, 0)

G5とG6の式を一緒にすれば
      =OFFSET($A$1, MATCH(G4, $E$1:$E$366, 0)-1, 0)

-------------------------------------------------------------------
この式では、基準日が休業日で、営業日数=0の場合には、基準日の「前営業日」が求まります。
「翌営業日」にする場合には、G4の式の不等号を変更します。
[G4] =IF(日数>0, G3+日数, IF(OFFSET($C$1, 基準日-$A$1, 0)="*", G3+日数+1, G3+日数))
    または
      =G3+日数+IF(日数<=0, IF(OFFSET($C$1, 基準日-$A$1, 0)="*", 1, 0), 0)

--------------------------------------------------------------------
全てを1式でまとめると
  =OFFSET($A$1, MATCH(OFFSET($D$1, 基準日-$A$1, 0)+日数+
      IF(日数<0, IF(OFFSET($C$1, 基準日-$A$1, 0)="*", 1, 0), 0), $E$1:$E$366, 0)-1, 0)

休業日&日数0で翌営業日ならば
  =OFFSET($A$1, MATCH(OFFSET($D$1, 基準日-$A$1, 0)+日数+
      IF(日数<=0, IF(OFFSET($C$1, 基準日-$A$1, 0)="*", 1, 0), 0),$E$1:$E$366, 0)-1, 0)

---------------------------------------------------------------------
NETWORKDAYS関数に相当する営業日数計算は、上記の同じカレンダーを使えば

  =OFFSET($D$1, 終了日-$A$1, 0)
      -OFFSET($D$1, 開始日-$A$1, 0)+(OFFSET($C$1, 開始日-$A$1, 0)<>"*")

で求まります。「日付1=日付2 & 日付1/2は休業日」の場合には「0」になります。

この式では、開始日>終了日の場合には正しく求まりません。
    正しい結果を得るには、開始日と終了日の内容を入れ替えて、結果に[-1]を乗じてください。
    =(OFFSET($D$1,MAX(開始日,終了日)-$A$1,0)
        -OFFSET($D$1,MIN(開始日,終了日)-$A$1,0)
          +(OFFSET($C$1,MIN(開始日,終了日)-$A$1,0)<>"*"))*IF(開始日<=終了日,1,-1)

サンプルブックをこちら(52KB)に用意してあります。




アドイン無しで営業日計算(ユーザー定義関数 編)

VBAを開いて、標準モジュールに以下のマクロを張り付ければ利用できます。

「第3引数:休日暦」には連続する日付と休日フラグで作られた休日カレンダーのセル範囲を指定します。
例1なら A1:C365 、例2なら A1:B365 を指定します。日付はセル範囲内の1列目で固定ですが、休日
フラグは2列目以降の任意の列で構いません。既定では2列目を休日フラグとしますが、例1のように曜日
列が入って休日フラグが2列目以外の場合は、「第4引数:休列」に列番号(例1ならば 3 )を指定します。
休日フラグの内容は「空文字=営業日、空文字以外の任意の文字=休業日」です。

例1: =WorkdayEX(日付, 日数, $A$1:$C$365, 3)
       =NetworkdaysEX(日付1, 日付2, $A$1:$C$365, 3)

例2: =WorkdayEX(日付, 日数, $A$1:$B$365)
       =NetworkdaysEX(日付1, 日付2, $A$1:$B$365)

休日暦 例1(曜日セルが別) 休日暦 例2
  (A) (B) (C) (A) (B)
( 1) 2003/ 1/ 1   2003/ 1/ 1(水)  
( 2) 2003/ 1/ 2 2003/ 1/ 2(木)
( 3) 2003/ 1/ 3   2003/ 1/ 3(金)  
( 4) 2003/ 1/ 4   2003/ 1/ 4(土)  
( 5) 2003/ 1/ 5 2003/ 1/ 5(日)
  :  
(365) 2003/12/31   2003/12/31(水)  


Public Function WorkdayEX(ByVal 日付 As Date, _
                          ByVal 日数 As Integer, _
                          ByVal 休日暦 As Range, _
                          Optional ByVal 休列 As Integer = 2) As Variant
Dim 暦日数 As Integer
Dim 暦日付1 As Date
Dim 暦日付2 As Date
Dim BaseRow As Long
Dim OffsetRow As Long
Dim wkStep As Integer
Dim i As Integer

    If (日数 = 0) Then
        WorkdayEX = CVErr(xlErrValue)
        Exit Function
    ElseIf (日数 > 0) Then
        wkStep = 1
    Else
        wkStep = -1
    End If

    With 休日暦
        If (休列 < 2) Or (休列 > .Columns.Count) Then
            WorkdayEX = CVErr(xlErrValue)       '[休日フラグ列]不正
            Exit Function
        End If

        暦日数 = .Rows.Count
        If Not IsDate(.Cells(1, 1).Value) Then
            WorkdayEX = CVErr(xlErrValue)       '[休日暦]不正
            Exit Function
        ElseIf Not IsDate(.Cells(暦日数, 1).Value) Then
            WorkdayEX = CVErr(xlErrValue)       '[休日暦]不正
            Exit Function
        End If
        暦日付1 = .Cells(1, 1).Value
        暦日付2 = .Cells(暦日数, 1).Value

        If (暦日付2 <> (暦日付1 + 暦日数 - 1)) Then
            WorkdayEX = CVErr(xlErrValue)       '[休日暦]不正
            Exit Function
        ElseIf (日付 < 暦日付1) Or (日付 > 暦日付2) Then
            WorkdayEX = CVErr(xlErrValue)       '[日付]範囲外
            Exit Function
        End If

        BaseRow = CLng(日付 - 暦日付1 + 1)      '[日付]位置
        If IsDate(.Cells(BaseRow, 1).Value) Then
            If (.Cells(BaseRow, 1).Value = 日付) Then
                'OK
            Else
                WorkdayEX = CVErr(xlErrValue)   '[休日暦]不正
                Exit Function
            End If
        Else
            WorkdayEX = CVErr(xlErrValue)       '[休日暦]不正
            Exit Function
        End If

        '---- 稼働日算出 ----
        i = 0
        OffsetRow = 0
        Do
            OffsetRow = OffsetRow + wkStep
            If (BaseRow + OffsetRow < 1) Or _
               (BaseRow + OffsetRow > 暦日数) Then
                WorkdayEX = CVErr(xlErrValue)    '[対象日]範囲外
                Exit Function
            End If
            If (.Cells(BaseRow + OffsetRow, 休列).Value = "") Then
                i = i + wkStep
            End If
        Loop Until (i = 日数)
        WorkdayEX = 日付 + OffsetRow
    End With
End Function

'------------------------------------------------------------------------

Public Function NetworkdaysEX(ByVal 日付1 As Date, _
                              ByVal 日付2 As Date, _
                              ByVal 休日暦 As Range, _
                              Optional ByVal 休列 As Integer = 2) As Variant
Dim 暦日数 As Integer
Dim 暦日付1 As Date
Dim 暦日付2 As Date
Dim DateRow1 As Long
Dim DateRow2 As Long
Dim wkStep As Integer
Dim i As Long
Dim j As Integer

    If (日付1 <= 日付2) Then
        wkStep = 1
    Else
        wkStep = -1
    End If

    With 休日暦
        If (休列 < 2) Or (休列 > .Columns.Count) Then
            NetworkdaysEX = CVErr(xlErrValue)       '[休日フラグ列]不正
            Exit Function
        End If

        暦日数 = .Rows.Count
        If Not IsDate(.Cells(1, 1).Value) Then
            NetworkdaysEX = CVErr(xlErrValue)       '[休日暦]不正
            Exit Function
        ElseIf Not IsDate(.Cells(暦日数, 1).Value) Then
            NetworkdaysEX = CVErr(xlErrValue)       '[休日暦]不正
            Exit Function
        End If
        暦日付1 = .Cells(1, 1).Value
        暦日付2 = .Cells(暦日数, 1).Value

        If (暦日付2 <> (暦日付1 + 暦日数 - 1)) Then
            NetworkdaysEX = CVErr(xlErrValue)       '[休日暦]不正
            Exit Function
        ElseIf (日付1 < 暦日付1) Or (日付1 > 暦日付2) Then
            NetworkdaysEX = CVErr(xlErrValue)       '[日付1]範囲外
            Exit Function
        ElseIf (日付2 < 暦日付1) Or (日付2 > 暦日付2) Then
            NetworkdaysEX = CVErr(xlErrValue)       '[日付2]範囲外
            Exit Function
        End If

        DateRow1 = CLng(日付1 - 暦日付1 + 1)        '[日付1]位置
        If IsDate(.Cells(DateRow1, 1).Value) Then
            If (.Cells(DateRow1, 1).Value = 日付1) Then
                'OK
            Else
                NetworkdaysEX = CVErr(xlErrValue)   '[休日暦]不正
                Exit Function
            End If
        Else
            NetworkdaysEX = CVErr(xlErrValue)       '[休日暦]不正
            Exit Function
        End If

        DateRow2 = CLng(日付2 - 暦日付1 + 1)        '[日付2]位置
        If IsDate(.Cells(DateRow2, 1).Value) Then
            If (.Cells(DateRow2, 1).Value = 日付2) Then
                'OK
            Else
                NetworkdaysEX = CVErr(xlErrValue)   '[休日暦]不正
                Exit Function
            End If
        Else
            NetworkdaysEX = CVErr(xlErrValue)       '[休日暦]不正
            Exit Function
        End If

        '---- 稼働日数算出 ----
        j = 0
        For i = DateRow1 To DateRow2 Step wkStep
            If (.Cells(i, 休列).Value = "") Then
                j = j + wkStep
            End If
        Next i
        NetworkdaysEX = j
    End With
End Function

 Home   Back Page   Next Page

ロゴ(ゴールド)   ロゴ(ゴールド)

角田 桂一 Mail:addinbox@h4.dion.ne.jp CopyRight(C) 2001 Allrights Reserved.