最新消息

[公告2014/05/30] 如有需要將部落格中,任何一篇文章的程式碼使用在商業用途,請與我聯繫。

[公告2015/04/26] Line版的 iInfo程式與投資應用 群組已上線想加入的朋友們,請先查看 "入群須知" 再與我聯繫 Line : aminwhite5168,加入請告知身分與回答 "入群須知" 的問題。

[公告2018/04/22] 台北 Python + Excel VBA 金融資訊爬蟲課程,課程如網頁內容 金融資訊爬蟲班:台北班 Python 金融資訊爬蟲、EXCEL VBA 金融資訊爬蟲

[公告2019/01/08] 請注意:我再次重申,部落格文章的程式碼,是要提供各位參考與學習,一旦網頁改版請自行修改,別要求東要求西要我主動修改,你們用我寫東西賺錢了、交差了,請問有分我一杯羹嗎?既然賺錢沒分我,請問有什麼理由要求我修改,如果沒能力改,就花錢來找我上課。

[公告2019/12/01] 若各位有 Excel VBA 案子開發需求,歡迎與我聯繫,可接案處理。

[公告2020/05/22] 頁面載入速度慢,起因為部分JS來源(alexgorbatchev.com)失效導致頁面載入變慢,目前已做調整,請多見諒。

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

執行結果: