RequestTenor.bas

Option Explicit


Public Function RequestTenor(ByRef TARGETDATE As Date, _
                    ByRef TENOR As String, _
                    ByRef PUBLICHOLIDAY As Range, _
                    ByVal CONVENTION As String, _
                    Optional ByVal Holidayshift = 0, _
                    Optional ByVal ReverseFLG = True) As Date

'引数---------------------------------------------------------------------------------------------------------------
'TARGETDATE                  : DateAdd(単位,加算時間,日時)の第3引数に渡す。セル範囲が1つでない場合エラー。
'                            : weekday関数で曜日を取得する。
                             '0：vbUseSystemDayOfWeek(PCのOSのシステム時間)
                             '1：vbSunday (日曜日)
                             '2：vbMonday (月曜日)
                             '3：vbTuesday (火曜日)
                             '4：vbWednesday (水曜日)
                             '5：vbThursday (木曜日)
                             '6：vbFriday (金曜日)
                             '7：vbSaturday (土曜日)
'TENOR                       : テナー一覧をConstClassで辞書として定義。テナーに対応する値はDateAdd
'                              DateAdd関数の第1・2引数に渡す。セル範囲が1つでない場合エラー。
'PUBLICHOLIDAY               : セル範囲に指定した全ての日付を重複削除したうえで辞書に格納。
'                               キーにセル範囲の日付､値にTRUEを格納｡
'CONVENTION                  : Business Day Conventionの設定を行う。
'                              MF : Modified Following
'                              F  : Following
'Holidayshift                : 再帰呼び出し回数のカウンタ
'ByValReverseFLG             : Modified Followingで月末と判定された場合に過去方向に平日を探すように挙動

'戻り値--------------------------------------------------------------------------------------------------------------
'PUBLICHOLIDAYの辞書の格納値がTRUE､もしくはweekday(DateAdd(,TARGETDATE,TENOR))
    
Dim CntList As Object
Dim AddedDate As Date
Dim cell As Variant
Dim dicPubHol As Object

  
'定数クラスをインスタンス化
Set CntList = New CstClass

'テナーの分シフトさせる
AddedDate = DateAdd(CntList.TENORFORMAT.Item(TENOR), CntList.TENORNUM.Item(TENOR), TARGETDATE)

'祝日であることを表すフラグを設定する。
Set dicPubHol = CreateObject("Scripting.Dictionary")
For Each cell In PUBLICHOLIDAY.Cells
    If dicPubHol.Exists(cell.Value) = False Then
        dicPubHol.Add Key:=cell.Value, Item:=True
    End If
Next
    
'平日だった場合はそのままテナーの分シフトさせた値を返す。
Select Case Weekday(AddedDate, vbSunday)
Case Is = vbMonday, vbTuesday, vbWednesday, vbThursday, vbFriday
    If dicPubHol.Item(AddedDate) = True Then
        GoTo RECURSIVE
    Else
        RequestTenor = AddedDate
    End If
    
'休日・祝日だった場合は翌日にシフトさせたうえで、再帰的に関数呼び出し
Case Is = vbSunday, vbSaturday
RECURSIVE:
                  
    '再帰関数の呼び出し回数をカウント
    If Holidayshift = 0 Then
        Holidayshift = 1
    ElseIf Holidayshift > 0 Then
        Holidayshift = Holidayshift + 1
    End If
                  
    If CONVENTION = "F" Then
        TARGETDATE = DateAdd("d", 1, TARGETDATE)
        
    ElseIf CONVENTION = "MF" Then
        '翌日が月末でない場合
        If ReverseFLG = False And Month(TARGETDATE) = Month(DateAdd("d", 1, TARGETDATE)) Then
            TARGETDATE = DateAdd("d", 1, TARGETDATE)
        
        '翌日が月末である場合
        ElseIf ReverseFLG = False And Month(TARGETDATE) <> Month(DateAdd("d", 1, TARGETDATE)) Then
            ReverseFLG = True
            TARGETDATE = DateAdd("d", -1 * Holidayshift, TARGETDATE)
            
        '月末であると判定され、月初方向に巻き戻し場合
        ElseIf ReverseFLG = True Then
            TARGETDATE = DateAdd("d", -1, TARGETDATE)
        End If
    End If
            
    dicPubHol.RemoveAll '祝日定義のディクショナリーを初期化
    RequestTenor = RequestTenor(TARGETDATE, TENOR, PUBLICHOLIDAY, CONVENTION, Holidayshift)
End Select
End Function

CstClass.cls

Option Explicit

Private TenorNumber As Object
Private TenorUnit As Object

Private Sub Class_Initialize()
  Call SetTenorNum
  Call SetTenorFormat
End Sub

Public Property Get TENORNUM() As Object
  Set TENORNUM = TenorNumber
End Property

Public Property Get TENORFORMAT() As Object
  Set TENORFORMAT = TenorUnit
End Property

Private Sub SetTenorNum()
  Set TenorNumber = CreateObject("Scripting.Dictionary")
  TenorNumber.Add Key:="O/N", Item:="1"
  TenorNumber.Add Key:="T/N", Item:="2"
  TenorNumber.Add Key:="SPOT", Item:="3"
  TenorNumber.Add Key:="S/N", Item:="4"
  TenorNumber.Add Key:="1D", Item:="1"
  TenorNumber.Add Key:="2D", Item:="2"
  TenorNumber.Add Key:="3D", Item:="3"
  TenorNumber.Add Key:="1W", Item:="7"
  TenorNumber.Add Key:="2W", Item:="14"
  TenorNumber.Add Key:="3W", Item:="21"
  TenorNumber.Add Key:="1M", Item:="1"
  TenorNumber.Add Key:="2M", Item:="2"
  TenorNumber.Add Key:="3M", Item:="3"
  TenorNumber.Add Key:="4M", Item:="4"
  TenorNumber.Add Key:="5M", Item:="5"
  TenorNumber.Add Key:="6M", Item:="6"
  TenorNumber.Add Key:="7M", Item:="7"
  TenorNumber.Add Key:="8M", Item:="8"
  TenorNumber.Add Key:="9M", Item:="9"
  TenorNumber.Add Key:="10M", Item:="10"
  TenorNumber.Add Key:="11M", Item:="11"
  TenorNumber.Add Key:="12M", Item:="12"
  TenorNumber.Add Key:="1Y", Item:="1"
  TenorNumber.Add Key:="15M", Item:="15"
  TenorNumber.Add Key:="18M", Item:="18"
  TenorNumber.Add Key:="2Y", Item:="2"
  TenorNumber.Add Key:="3Y", Item:="3"
  TenorNumber.Add Key:="4Y", Item:="4"
  TenorNumber.Add Key:="5Y", Item:="5"
  TenorNumber.Add Key:="6Y", Item:="6"
  TenorNumber.Add Key:="7Y", Item:="7"
  TenorNumber.Add Key:="8Y", Item:="8"
  TenorNumber.Add Key:="9Y", Item:="9"
  TenorNumber.Add Key:="10Y", Item:="10"
  TenorNumber.Add Key:="12Y", Item:="12"
  TenorNumber.Add Key:="15Y", Item:="15"
  TenorNumber.Add Key:="20Y", Item:="20"
  TenorNumber.Add Key:="25Y", Item:="25"
  TenorNumber.Add Key:="30Y", Item:="30"
End Sub


Private Sub SetTenorFormat()
  Set TenorUnit = CreateObject("Scripting.Dictionary")
  TenorUnit.Add Key:="O/N", Item:="d"
  TenorUnit.Add Key:="T/N", Item:="d"
  TenorUnit.Add Key:="SPOT", Item:="d"
  TenorUnit.Add Key:="S/N", Item:="d"
  TenorUnit.Add Key:="1D", Item:="d"
  TenorUnit.Add Key:="2D", Item:="d"
  TenorUnit.Add Key:="3D", Item:="d"
  TenorUnit.Add Key:="1W", Item:="d"
  TenorUnit.Add Key:="2W", Item:="d"
  TenorUnit.Add Key:="3W", Item:="d"
  TenorUnit.Add Key:="1M", Item:="m"
  TenorUnit.Add Key:="2M", Item:="m"
  TenorUnit.Add Key:="3M", Item:="m"
  TenorUnit.Add Key:="4M", Item:="m"
  TenorUnit.Add Key:="5M", Item:="m"
  TenorUnit.Add Key:="6M", Item:="m"
  TenorUnit.Add Key:="7M", Item:="m"
  TenorUnit.Add Key:="8M", Item:="m"
  TenorUnit.Add Key:="9M", Item:="m"
  TenorUnit.Add Key:="10M", Item:="m"
  TenorUnit.Add Key:="11M", Item:="m"
  TenorUnit.Add Key:="12M", Item:="m"
  TenorUnit.Add Key:="1Y", Item:="yyyy"
  TenorUnit.Add Key:="15M", Item:="m"
  TenorUnit.Add Key:="18M", Item:="m"
  TenorUnit.Add Key:="2Y", Item:="yyyy"
  TenorUnit.Add Key:="3Y", Item:="yyyy"
  TenorUnit.Add Key:="4Y", Item:="yyyy"
  TenorUnit.Add Key:="5Y", Item:="yyyy"
  TenorUnit.Add Key:="6Y", Item:="yyyy"
  TenorUnit.Add Key:="7Y", Item:="yyyy"
  TenorUnit.Add Key:="8Y", Item:="yyyy"
  TenorUnit.Add Key:="9Y", Item:="yyyy"
  TenorUnit.Add Key:="10Y", Item:="yyyy"
  TenorUnit.Add Key:="12Y", Item:="yyyy"
  TenorUnit.Add Key:="15Y", Item:="yyyy"
  TenorUnit.Add Key:="20Y", Item:="yyyy"
  TenorUnit.Add Key:="25Y", Item:="yyyy"
  TenorUnit.Add Key:="30Y", Item:="yyyy"
End Sub

上記関数をコードで実行する方法.bas

Sub sample()
    Dim 基準日 As Range
    Set 基準日 = ThisWorkbook.Sheets("Sheet1").Range("C2")
    Dim テナー As Range
    Set テナー = ThisWorkbook.Sheets("Sheet1").Range("D1")
    Dim 祝日 As Range
    Set 祝日 = ThisWorkbook.Sheets("Sheet1").Range("A2:A51")

    MsgBox RequestTenor(aaaa.Value, bbbb.Value, cccc, "MF")
End Sub

機能要件は盛り込めた(つもり)ですが、この関数は性能面で計算に時間がかかるため、改善案をご教示いただける場合はコメントでお知らせ頂けますと幸いです。