LoginSignup
0
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

More than 3 years have passed since last update.

@beautiful_life(Onigiri Onigiri)

金融のカレンダーにまつわる機能を実装したクラス

Posted at

金融のカレンダー周りで使用するクラスを記載。

Calendar.cls
Option Explicit

Private Const cntSONIA = "SONIA"
Private TenorNumber As Object
Private TenorUnit As Object
Private AccrualSpotLag As Object
Private AddedDate As Date
Private dicPubHol As Object
Private Cell As Range
Private ReverseFLG As Boolean


Private Sub Class_Initialize()
  Call SetTenorNum
  Call SetTenorFormat
  Call SetSpotLag
End Sub

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

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

Public Property Get SPOTLAG() As Object
  Set SPOTLAG = AccrualSpotLag
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

Private Sub SetSpotLag()
    Set AccrualSpotLag = CreateObject("Scripting.Dictionary")
    AccrualSpotLag.Add Key:="TONA", Item:=2
    AccrualSpotLag.Add Key:="SOFR", Item:=2
    AccrualSpotLag.Add Key:="SONIA", Item:=0
    AccrualSpotLag.Add Key:="ESTR", Item:=2
End Sub


Public Function BizDayCheck(ByRef CheckTarget As Date, ByRef PUBLICHOLIDAY As Range) As String
    Dim Cell As Range
    Dim dicPubHol As Object
    
    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
    If Weekday(CheckTarget) = vbSaturday Or Weekday(CheckTarget) = vbSunday Then
        BizDayCheck = "HOL"
    ElseIf dicPubHol.Item(CheckTarget) = True Then
        BizDayCheck = "HOL"
    Else
        BizDayCheck = "BIZ"
    End If
End Function


Public Function RequestShiftedBusinessday(ByRef TargetDate As Date, _
                                          ByRef ShiftLength As Long, _
                                          ByRef PUBLICHOLIDAY As Range) As Date
Dim Holidayshift As Long
Dim Direction As Long
Dim AddedDate As Date

If ShiftLength < 0 Then
    Direction = -1
ElseIf ShiftLength > 0 Then
    Direction = 1
Else
    RequestShiftedBusinessday = TargetDate
    Exit Function
End If

'テナーの分シフトさせる
AddedDate = DateAss("d", Direction, TargetDate)

'祝日であることを表すフラグを設定する。
If Holidayshift = 0 Then
    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
End If

Select Case Weekday(AddedDate, vbSunday)
Case Is = vbMonday, vbTuesday, vbWednesday, vbThursday, vbFriday
    If dicPubHol.Item(AddedDate) = True Then
        GoTo RECURSIVE
    Else
        If CountShiftLength = 0 Then
            CountShiftLength = Direction
        ElseIf CountShiftLength <> 0 Then
            CountShiftLength = CountShiftLength + Direction
        End If
        
        If ShiftLength <> CountShiftLength Then
            GoTo RECURSIVE
        Else
            RequestShiftedBusinessday = AddedDate
        End If
    End If
    
Case Is = vbSunday, vbSaturday
RECURSIVE:
    TargetDate = DateAdd("d", Direction, TargetDate)
    dicPubHol.RemoveAll
    RequestShiftedBusinessday = RequestShiftedBusinessday(TargetDate, ShiftLength, PUBLICHOLIDAY)
End Select
End Function

Public Function FollowingTenor(ByRef TargetDate As Date, _
                               ByRef Tenor As String, _
                               ByRef PUBLICHOLIDAY As Range) As Date
Dim Holidayshift As Long
Dim AddedDate As Date
Dim dicPubHol As Object
Dim Cell As Range

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

'祝日であることを表すフラグを設定する。
If Holidayshift = 0 Then

    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
End If

Select Case Weekday(AddedDate, vbSunday)
Case Is = vbMonday, vbTuesday, vbWednesday, vbThursday, vbFriday
    If dicPubHol.Item(AddedDate) = True Then
        GoTo RECURSIVE
    Else
        FollowingTenor = AddedDate
    End If
    
Case Is = vbSunday, vbSaturday
RECURSIVE:
    
    If Holidayshift = 0 Then
        Holidayshift = 1
    ElseIf Holidayshift > 0 Then
        Holidayshift = Holidayshift + 1
    End If
    
    TargetDate = DateAdd("d", 1, TargetDate)
    
    dicPubHol.RemoveAll
    FollowingTenor = FollowingTenor(TargetDate, Tenor, PUBLICHOLIDAY)

End Select
End Function

'RequestTenorメソッド-----------------------------------------------------------------------------------------------
'
'引数---------------------------------------------------------------------------------------------------------------
'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を格納｡
'戻り値--------------------------------------------------------------------------------------------------------------
'PUBLICHOLIDAYの辞書の格納値がTRUE､もしくはweekday(DateAdd(,TARGETDATE,TENOR))


Public Function RequestTenor(ByRef TargetDate As Date, _
                             ByRef Tenor As String, _
                             ByRef PUBLICHOLIDAY As Range) As Date

Dim Holidayshift As Long

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

'祝日であることを表すフラグを設定する。
If Holidayshift = 0 Then
    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
            dicPubHol(Cell.Value) = True
        End If
    Next
End If


'平日だった場合はそのままテナーの分シフトさせた値を返す。
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
Exit Function


'休日・祝日だった場合は翌日にシフトさせたうえで、再帰的に関数呼び出し
Case Is = vbSunday, vbSaturday
RECURSIVE:

    '再帰関数の呼び出し回数をカウント
    If Holidayshift = 0 Then
        Holidayshift = 1
    ElseIf Holidayshift > 0 Then
        Holidayshift = Holidayshift + 1
    End If

    '翌日が月末でない場合
    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

    dicPubHol.RemoveAll '祝日定義のディクショナリーを初期化
    RequestTenor = RequestTenor(TargetDate, Tenor, PUBLICHOLIDAY)
    ReverseFLG = False
End Select
End Function

Public Function RequestAccrualEndDate(ByRef RateRecordDay As Date, _
                                      ByRef Tenor As String, _
                                      ByRef ACCRUALPUBLICHOLIDAY As Range, _
                                      ByVal INTEREST As String) As Date
Dim SpotDate As Date
Dim AccrualStartDate As Date
Dim DiffSpotOffset As Long
Dim Count As Long
Dim ccySpotLag As Long
Dim dicAccrualPubHol As Object
Dim Offsetlag As Long

Set dicAccrualPubHol = CreateObject("Scripting.Dictionary")

For Each Cell In ACCRUALPUBLICHOLIDAY.Cells
    If dicAccrualPubHol.exists(Cell.Value) = False Then
        dicAccrualPubHol.Add Key:=Cell.Value, Item:=True
    End If
Next



SpotDate = RateRecordDay
Count = 0

ccySpotLag = SPOTLAG.Item(INTEREST)
If ccySpotLag <> 0 Then
    Do
        If dicAccrualPubHol.Item(DateAdd("d", 1, SpotDate)) = True Then
            SpotDate = DateAdd("d", 1, SpotDate)
        ElseIf Weekday(DateAdd("d", 1, SpotDate)) = vbSunday Then
            SpotDate = DateAdd("d", 1, SpotDate)
        ElseIf Weekday(DateAdd("d", 1, SpotDate)) = vbSaturday Then
            SpotDate = DateAdd("d", 1, SpotDate)
        Else
            SpotDate = DateAdd("d", 1, SpotDate)
            Count = Count + 1
        End If
    Loop Until ccySpotLag = Count
End If

AccrualStartDate = SpotDate
Count = 0
Do
    If dicAccrualPubHol.Item(DateAdd("d", -1, AccrualStartDate)) = True Then
        AccrualStartDate = DateAdd("d", -1, AccrualStartDate)
    ElseIf Weekday(DateAdd("d", -1, AccrualStartDate)) = vbSunday Then
        AccrualStartDate = DateAdd("d", -1, AccrualStartDate)
    ElseIf Weekday(DateAdd("d", -1, AccrualStartDate)) = vbSaturday Then
        AccrualStartDate = DateAdd("d", -1, AccrualStartDate)
    Else
        AccrualStartDate = DateAdd("d", -1, AccrualStartDate)
        Count = Count - 1
    End If
Loop Until Offsetlag = Count

Dim tmpAccrualStartDate As Date
tmpAccrualStartDate = AccrualStartDate

RequestAccrualEndDate = Me.RequestTenor(tmpAccrualStartDate, Tenor, ACCRUALPUBLICHOLIDAY)
Debug.Print "RFR: " & INTEREST & ", TENOR: " & Tenor & _
", RATERECORDDAY: " & RateRecordDay & ", SpotDate: " & SpotDate & ", AccrualStartDate: " & AccrualStartDate & ", AccrualEndDate;" & RequestAccrualEndDate

End Function



Public Function RequestRateRecordDay(ByRef ACCRUALENDTARGET As Date, _
                                     ByRef Tenor As String, _
                                     ByRef ACCRUALPUBLICHOLIDAY As Range, _
                                     ByRef INTEREST As Date) As Object

Dim elemDataRange As Date
Dim AccrualStartDate As Date
Dim DiffSpotOffset As Long
Dim Cell As Variant
Dim dicAccrualPubHol As Object: Set dicAccrualPubHol = CreateObject("Scripting,Dictionary")


ReqRRDCount = ReqRRDCount + 1

For Each Cell In ACCRUALPUBLICHOLIDAY
    If dicAccrualPubHol.exists(Cell) = False Then
        dicAccrualPubHol(Cell.Value) = True
    End If

Dim dicAccrualDateRange As Object: Set dicAccrualDataRange = CreateObject("Scripting.Dictionary")
dicAccrualDateRange.Add Key:="ON", Item:=15
dicAccrualDateRange.Add Key:="SN", Item:=15
dicAccrualDateRange.Add Key:="1W", Item:=20
dicAccrualDateRange.Add Key:="1M", Item:=45
dicAccrualDateRange.Add Key:="2M", Item:=75
dicAccrualDateRange.Add Key:="3M", Item:=105
dicAccrualDateRange.Add Key:="6M", Item:=195
dicAccrualDateRange.Add Key:="12M", Item:=380

elemDataRange = DateAdd("d", dicAccrualDateRange.Item(Tenor) * -1, ACCRUALENDTARGET)

Do While Weekday(elemDataRange) = vbSaturday Or Weekday(elemDataRange) = vbSunday
    elemDataRange = DateAdd("d", -1, elemDataRange)
Loop

Dim INTERMdicRateRecord_AccrualEnd As Object: setINTERMdicRateRecord_AccrualEnd = CrateObject("Scripting.Dictionary")

Dim dicRateRecord_AccrualEnd As Object: Set dicRateRecord_AccrualEnd = CreateObject("Scripting.Dictionary")

INTERMdicRateRecord_AccrualEnd.Add Key:=elemDataRange, _
Item:=Me.RequestAccrualEndDate(elemDataRange, Tenor, ACCRUALPUBHOLIDAY, INTEREST)

Do Until INTERMdicRateRecord_AccrualEnd.Item(elemDataRange) >= ACCRUALENDTARGET
elemDataRange = DataAdd("d", 1, elemDataRange)

    If Weekday(elemDataRange) <> vbSaturday And Weekday(elemDataRange) <> vbSunday Then
        If Tenor = "ON" And INTEREST = cntSONIA Then
            INTERMdicRateRecord_AccrualEnd.Add Key:=elemDataRange, Item:=elemDataRange
            dicRateRecord_AccrualEnd.Add Key:=elemDataRange, Item:=elemDataRange
        Else
            INTERMdicRateRecord_AccrualEnd.Add Key:=elemDataRange, _
            Item:=Me.RequestAccrualEndDate(elemDataRange, Tenor, ACCRUALPUBLICHOLIDAY, INTEREST)
            
            dicRateRecord_AccrualEnd.Add Key:=elemDataRange, _
            Item:=Me.RequestAccrualEndDate(elemDataRange, Tenor, ACCRUALPUBLICHOLIDAY, INTEREST)
        End If
    End If

Loop

Set RequestRateRecordDay = dicRateRecord_AccrualEnd

End Function
0
0
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
Sign upLogin
0
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?