程式的重點在於程式碼的16、38行的內容,尤其16行宣告為 nCount *0 與 0*0 的2維陣列,因為要讓陣列內容直接放入儲存格中,因此宣告 N*N 與 N*N 的2維陣列。若以N*1的1維陣列,38行中儲存格資料內容只會存入陣列第0個位置的資料,這部分需要多注意。
台指結算日為"每個月第三週的星期三"結算,有了結算日的觀念後,來看以下程式碼就會很快上手。
Sub 自動產生台指結算日() Dim dPastdate As Date Dim dBasedate As Date Dim dCurrentdate As Date Dim nCount As Integer, nGap As Integer Dim i As Integer, j As Integer Dim astrDatelist() As String With Workbooks(1).Sheets("結算日") .Range(.Cells(2, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 1)).Clear End With '以當月日期為基準前後計算10個月結算日 nGap = 10 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)) For j = 14 To 24 dCurrentdate = dBasedate + j If 日期是當月第三週星期三(dCurrentdate) Then astrDatelist(i, 0) = Format(Year(dCurrentdate), "0000") & Format(Month(dCurrentdate), "00") & Format(Day(dCurrentdate), "00") Exit For End If Next Next With Workbooks(1).Sheets("結算日") For i = 2 To .Cells(Rows.Count, 2).End(xlUp).Row For j = LBound(astrDatelist) To UBound(astrDatelist) If Mid(astrDatelist(j, 0), 1, 6) = Mid(.Cells(i, 2), 1, 6) Then astrDatelist(j, 0) = .Cells(i, 2) End If Next Next .Range(.Cells(2, 1), .Cells(2 + nCount, 1)).Value = astrDatelist End With End Sub Function 日期是當月第三週星期三(dBasedate As Date) As Boolean Dim weekofMonth As Integer, dayofweek As Integer 日期是當月第三週星期三 = False weekofMonth = DatePart("ww", dBasedate) - DatePart("ww", DateSerial(Year(dBasedate), Month(dBasedate), 1)) dayofweek = weekday(DateSerial(Year(dBasedate), Month(dBasedate), 1), 2) If dayofweek <= 3 Or dayofweek = 7 Then weekofMonth = weekofMonth + 1 End If If weekofMonth = 3 And DatePart("w", dBasedate, 2) = 3 Then 日期是當月第三週星期三 = True End If End Function執行結果:
結算日特性:
- 每月第三周星期三。
- 每月結算日落在14~24號之間。
- 每月1號在星期三之前(含),以當月第三周星期三為結算日。
- 每月號在星期日,以當月第三周星期三為結算日。
- 每月1號在星期三之後,以當月第四周星期三為結算日。
參考資料: