使用Excel VBA抓加權指數歷史資料,效能會差一些,不過如果你不是一個很迫切追求時效的人,基本上還是可以考慮筆者提供的方法。如果是急迫的朋友們,那筆者會建議使用Python去產生資料了,這裡僅提供Excel VBA的方式,後續再提供Python的方法。
簡單說明程式碼的方法。
- 抓取證交所 加權指數每5秒委託成交統計 與 加權指數每5秒指數統計。
- 整理加權指數的指數與成交金額。
- 輸出每日加權指數的資料成TXT檔。
- 將每日加權指數資料整合至同一份TXT檔。
2016/07/15 更新證交所的 每5秒指數盤後統計 CSV下載連結。
2016/08/13 更新證交所的 每日市場成交資訊 CSV下載連結。
Option Explicit Dim nStartYear As Integer Dim nStartMonth As Integer Dim nStartDay As Integer Dim nEndYear As Integer Dim nEndMonth As Integer Dim nEndDay As Integer Dim sFilePath As String Sub 執行() Application.ScreenUpdating = False sFilePath = ThisWorkbook.Path & "\TWSE" If Dir(sFilePath, vbDirectory) = "" Then MkDir (sFilePath) End If With Worksheets("交易日期") .UsedRange.ClearContents .Cells(1, 1) = "交易日期" End With With Worksheets("執行") nStartYear = .[B2] nStartMonth = .[C2] nStartDay = .[D2] nEndYear = .[B3] nEndMonth = .[C3] nEndDay = .[D3] End With 建立交易日期序列 依日期產生檔案 寫入同一份檔案 Application.StatusBar = "指定日期的TWSE Tick資料抓取完成!!!" Application.ScreenUpdating = True End Sub Sub 建立交易日期序列() Dim i As Integer Dim nCount, nStartPos, nEndPos, nGaps As Integer Dim URL As String Dim sDate As String Dim sFilePath As String Dim sStartDate, sEndDate As String Dim sTemp, oBaseDate Application.StatusBar = "建立指定日期序列......" If nStartYear = nEndYear And nStartMonth = nEndMonth And nStartDay = nEndDay Then Worksheets("交易日期").Range("A2") = Format(nStartYear, "0000") & "/" & Format(nStartMonth, "00") & "/" & Format(nStartDay, "00") Else sStartDate = Format(nStartYear, "0000") & "/" & Format(nStartMonth, "00") & "/" & Format(nStartDay, "00") sEndDate = Format(nEndYear, "0000") & "/" & Format(nEndMonth, "00") & "/" & Format(nEndDay, "00") nGaps = DateDiff("m", sStartDate, sEndDate) URL = "http://www.twse.com.tw/ch/trading/exchange/FMTQIK/FMTQIK.php" For i = 0 To nGaps nCount = Worksheets("交易日期").Range("C65536").End(xlUp).Row + 1 oBaseDate = DateAdd("m", i, CDate(sStartDate)) sFilePath = "c:\每日市場成交資訊.csv" 下載檔案 URL, sFilePath, Format(Year(oBaseDate), "0000") & Format(Month(oBaseDate), "0"), 1 With Workbooks.Open(sFilePath) nEndPos = .ActiveSheet.Range("B65536").End(xlUp).Row .ActiveSheet.Range("A3:A" & nEndPos).Copy Destination:=ThisWorkbook.Worksheets("交易日期").Range("C" & nCount) .Close 0 End With Next i With Worksheets("交易日期") nCount = .Range("C65536").End(xlUp).Row For i = 2 To nCount sTemp = Split(.Cells(i, 3), "/") .Cells(i, 3) = CStr(CInt(sTemp(0)) + 1911) + "/" + sTemp(1) + "/" + sTemp(2) Next sDate = Format(nStartYear, "0000") & "/" & Format(nStartMonth, "0") & "/" & Format(nStartDay, "0") For i = 2 To nCount If DateDiff("d", sDate, .Range("C" & i)) >= 0 Then nStartPos = i Exit For End If Next sDate = Format(nEndYear, "0000") & "/" & Format(nEndMonth, "0") & "/" & Format(nEndDay, "0") For i = nCount To 2 Step -1 If DateDiff("d", sDate, .Range("C" & i)) <= 0 Then nEndPos = i Exit For End If Next .Range("C" & nStartPos & ":C" & nEndPos).Copy Destination:=.Range("A2") .Range("C:C").Clear End With End If Application.StatusBar = "指定日期序列建立完成......" End Sub Sub 依日期產生檔案() Dim i As Integer Dim nCount As Integer Dim sDate1 As String Dim sDate2 As String Dim sTemp With Worksheets("交易日期") nCount = .Cells(Rows.Count, 1).End(xlUp).Row For i = 2 To nCount sTemp = Split(.Range("A" & i), "/") sDate1 = Format(sTemp(0), "0000") & Format(sTemp(1), "00") & Format(sTemp(2), "00") sDate2 = Format(CStr(CInt(sTemp(0)) - 1911), "000") & "/" & Format(sTemp(1), "00") & "/" & Format(sTemp(2), "00") Application.StatusBar = "正在產生 TWSE_Tick_" & sDate1 & ".txt 檔案 ......" 建立檔案 sDate1, sDate2 Next End With End Sub Sub 建立檔案(sDate1 As String, sDate2 As String) Dim i As Integer Dim nCount As Integer With Worksheets("TWSE") .Cells.Clear .Cells(1, 1) = "Date" .Cells(1, 2) = "Time" .Cells(1, 3) = "Price" .Cells(1, 4) = "Volume" End With Application.StatusBar = "抓取" & sDate1 & "TWSE價格......" 抓TWSE價格 sDate2 Application.StatusBar = "抓取" & sDate2 & "TWSE成交金額......" 抓TWSE成交金額 sDate2 With Worksheets("TWSE") nCount = .Cells(Rows.Count, 2).End(xlUp).Row For i = 2 To nCount .Cells(i, 1) = Format(Mid(sDate1, 1, 4), "0000") & "/" & Format(Mid(sDate1, 5, 2), "0") & "/" & Format(Mid(sDate1, 7, 2), "0") .Range("A" & i).NumberFormatLocal = "yyyy/mm/dd" .Range("B" & i).NumberFormatLocal = "hh:mm:ss" .Range("C" & i).NumberFormatLocal = "0.00" Next End With Application.StatusBar = "建立 TWSE_Tick_" & sDate1 & ".txt ......" 輸出TXT sDate1 Application.StatusBar = "建立 TWSE_Tick_" & sDate1 & ".txt 完成......" End Sub Sub 抓TWSE價格(sDate As String) Dim URL As String Dim sFilePath As String URL = "http://www.twse.com.tw/ch/trading/exchange/MI_5MINS_INDEX/MI_5MINS_INDEX.php" sFilePath = "c:\每5秒指數盤後統計.csv" 下載檔案 URL, sFilePath, sDate, 2 With Workbooks.Open(sFilePath) .ActiveSheet.Range("A4:B3243").Copy Destination:=ThisWorkbook.Worksheets("TWSE").Range("B2") .Close 0 End With If Dir(sFilePath) <> "" Then Kill sFilePath End Sub Sub 抓TWSE成交金額(sDate As String) Dim URL As String Dim nCount As Integer Dim i As Integer Dim sFilePath As String URL = "http://www.twse.com.tw/ch/trading/exchange/MI_5MINS/MI_5MINS2.php?input_date=" & sDate & "&type=csv" sFilePath = "c:\每5秒委託成交統計.csv" 下載檔案 URL, sFilePath, "", 0 With Workbooks.Open(sFilePath) nCount = .ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row .ActiveSheet.Cells(3, 9) = 0 For i = 4 To nCount .ActiveSheet.Cells(i, 9) = (.ActiveSheet.Cells(i, 8) - .ActiveSheet.Cells(i - 1, 8)) * 100 Next .ActiveSheet.Range("I4:I" & nCount).Copy Destination:=ThisWorkbook.Worksheets("TWSE").Range("D2") .Close 0 End With If Dir(sFilePath) <> "" Then Kill sFilePath End Sub Sub 輸出TXT(sDate As String) Dim sPath As String Dim nCount As Integer sPath = sFilePath & "\每日資料" If Dir(sPath, vbDirectory) = "" Then MkDir (sPath) End If ' With Worksheets("TWSE") ' nCount = .Cells(Rows.Count, 1).End(xlUp).Row ' .Range("B2:C" & nCount).ClearFormats ' .Range("B2:B" & nCount).NumberFormatLocal = "hh:mm:ss" ' End With Workbooks.Add ThisWorkbook.Worksheets("TWSE").Cells.Copy Destination:=Workbooks(2).Worksheets(1).Range("A1") Application.DisplayAlerts = False Workbooks(2).Worksheets(1).SaveAs sPath & "\TWSE_Tick_" & sDate & ".txt", FileFormat:=xlCSV, CreateBackup:=False Application.DisplayAlerts = True Workbooks(2).Close 0 End Sub Sub 寫入同一份檔案() Dim i As Integer Dim nCount, nRow As Integer Dim sPath_R As String Dim sPath_W As String Dim Str_R As String, Val1 As Long Dim sDate1 As String Dim sDate2 As String Dim sDate3 As String Dim sTemp sPath_W = sFilePath & "\整合資料" If Dir(sPath_W, vbDirectory) = "" Then MkDir (sPath_W) End If sDate1 = Format(nStartYear, "0000") & Format(nStartMonth, "00") & Format(nStartDay, "00") sDate2 = Format(nEndYear, "0000") & Format(nEndMonth, "00") & Format(nEndDay, "00") Application.StatusBar = "整合所有日期TWSE Tick資料到 " & sDate1 & "_" & sDate2 & ".txt" sPath_W = sPath_W & "\TWSE_Tick_" & sDate1 & "_" & sDate2 & ".txt" Open sPath_W For Output As #1 Print #1, "Date, Time, Price, Volume" With Workbooks(1).Sheets("交易日期") nCount = .Range("A65536").End(xlUp).Row For i = 2 To nCount sTemp = Split(.Range("A" & i), "/") sDate3 = Format(sTemp(0), "0000") & Format(sTemp(1), "00") & Format(sTemp(2), "00") sPath_R = sFilePath & "\每日資料\TWSE_Tick_" & sDate3 & ".txt" Open sPath_R For Input As #2 nRow = 0 Do Until EOF(2) Line Input #2, Str_R If nRow > 0 Then Print #1, Str_R End If nRow = nRow + 1 Loop Close #2 Next End With Close #1 End Sub Sub 下載檔案(URL As String, xlFilename As String, sDate As String, nType As Integer) Dim oXMLHTTP, objStream As Object Set oXMLHTTP = CreateObject("Microsoft.XMLHTTP") Set objStream = CreateObject("ADODB.stream") With oXMLHTTP .Open "POST", URL, False .setRequestHeader "Content-Type", "application/x-www-form-urlencoded" Select Case nType Case 1: .send "download=csv&query_year=" & Mid(sDate, 1, 4) & "& query_month=" & Mid(sDate, 5, 1) Case 2: .send "download=csv&qdate=" + sDate Case Else .send End Select If .Status = 200 Then With objStream .Type = 1 .Open .Write oXMLHTTP.ResponseBody If Dir(xlFilename) <> "" Then Kill xlFilename .SaveToFile xlFilename .Close End With End If End With Set oXMLHTTP = Nothing Set objStream = Nothing End SubExcel VBA檔案的畫面。
產生TWSE Tick資料存放的資料夾。
TWSE Tick的TXT檔。
TWSE Tick文字檔。