2016年12月25日 星期日

Excel VBA自動產生摩台結算日

前一篇 Excel VBA自動產生台指結算日 說明了台指結算日的規則與程式碼,接著筆者也將摩台結算日的規則與程式碼也一起分享。
摩台結算日為每個月倒數第2個交易日,有以下4種規則:
  1. 每個月倒數第2個交易日,落在週一 ~ 週四,當天為結算日。
  2. 每個月倒數第2個交易日,落在週五,則前1天為結算日。
  3. 每個月倒數第2個交易日,落在週六 ~ 週日,則前2天為結算日。
  4. 年節封關提早、農曆年節提早、7月~8月颱風延後,需手動調整。
依據以上4種規則,前3種規則可藉由程式達成,第4種規則為不可抗拒因素,需人工調整。
Sub 自動產生摩台結算日()
    Dim dPastdate As Date
    Dim dBasedate As Date
    Dim dCurrentdate As Date
    Dim nCount As Integer, nGap As Integer
    Dim i As Integer
    Dim astrDatelist() As String

    With Workbooks(1).Sheets("結算日")
        .Range("C2:C" & .Cells(Rows.Count, 1).End(xlUp).Row).Clear
    End With
    
    '以當月日期為基準前後計算15個月結算日
    nGap = 15
    nCount = nGap * 2 + 1
    ReDim astrDatelist(0 To nCount, 0 To 0)
    
    dPastdate = DateAdd("m", nGap * (-1), Date)
    For i = 0 To nCount
        dBasedate = DateAdd("m", i, DateSerial(Year(dPastdate), Month(dPastdate), 1))
        dCurrentdate = 每月結算日日期(dBasedate)
        astrDatelist(i, 0) = Format(Year(dCurrentdate), "0000") & Format(Month(dCurrentdate), "00") & Format(Day(dCurrentdate), "00")
    Next
    
    With Workbooks(1).Sheets("結算日")
        For i = 2 To .Cells(Rows.Count, "B").End(xlUp).Row
            For j = LBound(astrDatelist) To UBound(astrDatelist)
                If Mid(astrDatelist(j, 0), 1, 6) = Mid(.Cells(i, "B"), 1, 6) Then
                    astrDatelist(j, 0) = .Cells(i, "B")
                End If
            Next
        Next
        .Range(.Cells(2, 1), .Cells(2 + nCount, 1)).Value = astrDatelist
    End With
End Sub
'摩台期結算日規則
Function 每月結算日日期(dBasedate As Date) As Date
    Dim i As Integer
    Dim Dayofweek As Integer
    每月結算日日期 = Date
    i = 0
    i = i - 1
    Dayofweek = Weekday(DateSerial(Year(dBasedate), Month(dBasedate) + 1, i), 2)
    If Dayofweek = 5 Then
        i = i - 1
    ElseIf Dayofweek = 6 Or Dayofweek = 7 Then '倒數第2天為假日,要往前推2天
        i = i - 2
    End If
    每月結算日日期 = DateSerial(Year(dBasedate), Month(dBasedate) + 1, i)
End Function

執行結果: