使用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 Sub
Excel VBA檔案的畫面。
產生TWSE Tick資料存放的資料夾。
TWSE Tick的TXT檔。
TWSE Tick文字檔。
