最新消息

[公告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年6月17日 星期五

抓取TWSE Tick資料不求人--- Excel VBA篇

在MultiCharts程式交易中,有一個策略就是用加權指數(TWSE)與台指期指數(TXF)的價差來做進場的依據,在開發策略回測驗證時,歷史資料就很珍貴,有鑑於歷史資料取得不易,筆者花了一點時間用Excel VBA來寫一個抓取證交所加權指數歷史資料來產生TWSE Tick資料,希望能能幫助大家。
使用Excel VBA抓加權指數歷史資料,效能會差一些,不過如果你不是一個很迫切追求時效的人,基本上還是可以考慮筆者提供的方法。如果是急迫的朋友們,那筆者會建議使用Python去產生資料了,這裡僅提供Excel VBA的方式,後續再提供Python的方法。
簡單說明程式碼的方法。
  1. 抓取證交所 加權指數每5秒委託成交統計 與 加權指數每5秒指數統計
  2. 整理加權指數的指數與成交金額。
  3. 輸出每日加權指數的資料成TXT檔。
  4. 將每日加權指數資料整合至同一份TXT檔。
有興趣的朋友可使用以下程式碼產生TWSE Tick資料。
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文字檔。