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