返回列表 上一主題 發帖

證交所全部上市股票交易明細下載

證交所全部上市股票交易明細下載

花了一些時間以Excel VBA寫了一個下載交易明細Debug version,主要在做時間的優化處理,Release version可能需要再多點時間進行參數final duel
現在附上使用python與Excel VBA執行完成的圖案,python執行的時間2603秒,Excel VBA執行時間7598秒(未優化前),兩者相差約2.9倍
這兩個都是在有線網路20M/4M, 雙核心雙執行緒2G Hz CPU, 4G RAM, XP OS SP3規則所跑出來的結果
也試過在無線3.5G, i7四核心8執行緒 2.3G Hz CPU, 4G RAM, win7 OS SP1跑出約相差4倍的差距,所以如果執行環境越差,跑出來的結果相差越大
目前經過幾天的壓力測試,結果在可接受的範圍內,雖然已經努力進行優化了,但整體花費時間比起python的時間,仍需要做優化
至於下載明細所儲存的檔案格式在之後如使用者有需要再做調整

目前該Excel VBA 交易明細.xls 為V1.0.0.1 T01
其功能如下
1.開啟時會自動將當天的日期設定,並將欲取得的上市股票ID編號重頭開始(這裡是2)
2.下載儲存交易明細日期與上市股票ID編號,可自行設定
3.當資料取得過程發生在某一個網頁有問題時,會自動記錄,以供再次下載有問題股票之用
4.當網頁開啟有問題時,及遠端證交所伺服器過忙碌時,將會進行Retry直到取得資料
5.當Retry 5次無法下載市股票ID的總頁數網頁時,會記錄該日期與股票以供參考
6.自動記錄有交易日期各股票在證交所網頁上的總頁數
7.會自動將股票ID與交易明細儲存為CSV檔

由於是Debug version,若是使用上有任何問題歡迎提出或是需要添加何種功能也可以提出討論

Python_20120801

python_20120801.JPG

ExcelVBA_20120801

ExcelVBA_20120801.JPG

交易明細.rar (189.27 KB)

回復 1# white5168


感謝分享!!
雖然我權限不到還無法拜讀
不過應該快了...
想先問一下下載下來的檔案大概多大呢(總共)?
有這方面的問題想跟大大請教

TOP

回復 1# white5168

    分析的很詳細,謝謝!
拜讀了大作,希望大師多點python方面的教學指導
先別計較開不開 [專屬版] ; 語言這條路,五花八門
只要有門路,相信大家都很樂意學習
更不會計較在哪裡學習

相信你是[愛之深,責之切]
否則你不會繼續在這裡討論python語言的功力

我很外行,說的不貼切還請海涵
但有人願意分享教學 or 解決語法bug的困擾
才是這條路的前進動力

否則只能望著大師的作品而 "捶心肝"
沒法真的入門,連學習的動力都沒有說

還請大大繼續 [指導] 入門 及 其他分享
~~感恩!

TOP

雖說基礎不足,吸收有限,但非常感謝大大慹心分享敎學.!!!!

TOP

回復 1# white5168


    你好,是可以用,可以寫說買賣大於1000張以上的資料,另外可以下載五天前的資料嗎?謝謝。
devidlin

TOP

本帖最後由 HSIEN6001 於 2012-8-4 10:47 編輯

回復 1# white5168

請問大師    --->(PS:三人行必有我師!在我眼裡,在這邊的都是導師。)
因末學用無線3.5G下載,時常會卡住(停頓).正在找語法bug ,或僅是流量不穩定問題!!

在您的語法內(針對下載部分),有幾個疑問先請教
    Application.DisplayAlerts = False       'False 不想被提示跟警報,例如:覆蓋的默認---->在此網頁有特別作用??  範例中尚未看到這應用;我RUN會卡住(停頓).是因為少這段?
....(省略)....
        .RefreshStyle = xlInsertDeleteCells    '插入新資料,原資料右移----->????為何不是用覆蓋的方式
....(省略)....
  1.         On Error Resume Next
  2.             Do
  3.                 Err.Clear      
  4.             .Refresh BackgroundQuery:=False     '刷新返回查詢(執行更新)
  5.             
  6.             If Err.Number Then  '------->是指刷新查詢更新,延遲的等候?!
  7.                 Application.Wait Now + TimeValue("00:00:01")
  8.             End If
  9.             
  10.             Loop Until Err.Number = 0   '---->迴圈處理直到err=0 才算完成 (經典)
  11.         
  12.         'If Err.Number <> 0 Then Err.Clear: MsgBox Err.Number    '被免資料抓取不成功,而顯示訊息
  13.         On Error GoTo 0
  14.     End With
  15.         

  16.     If Err.Number = 0 Then
  17.         Application.DisplayAlerts = True    'True 需提示跟警報? ---->True 及 Flase 的應用,還不是很理解.只是爬文所得的大意,望請稍加說明
  18.         Exit Sub
  19.     End If
複製代碼

TOP

本帖最後由 GBKEE 於 2012-8-5 09:23 編輯

回復 1# white5168
測試 完成圖
EX1.GIF
2012-8-4 11:32


2012/8/5 更新程式碼
   
  1. Option Explicit
  2. Dim SH(1 To 2) As Worksheet, IE As Object
  3. Dim xltheCsv As String, xLMsg As String, Rng As Range
  4. Const xlPath = "D:\Test1\"                  '可修改CSV存檔的路徑
  5. Sub 全部日報表()                            '查詢全部日股票報表
  6.     Dim T As Date
  7.     存檔資料夾
  8.     T = Time
  9.     xLMsg = ""                              '紀錄 股票代號沒報表
  10.     上市股票代號                            '取得最新上市股票代號表
  11.     網頁                                    '開啟網頁
  12.     Set Rng = SH(1).[A3]                    '股票代號
  13.     Do
  14.         Rng.Select
  15.         ActiveWindow.ScrollRow = Rng.Row - 1
  16.         Application.ScreenUpdating = False
  17.         If Rng.Offset(, 1) <> "" Then 匯入日報表 Trim(Split(Rng, " ")(0))                                            'Trim(Split(Rng, " ")(0)):股票代號
  18.         Set Rng = Rng.Offset(1)             '下一個 股票代號
  19.         Application.ScreenUpdating = True
  20.     'Loop Until Rng = ""                    '<-含   上市股票,上市認購(售)權證,受益證券-不動產投資信託--
  21.     Loop Until Rng.Offset(, 1) = ""         '<-僅有 上市股票 : B欄是空白時離開迴圈
  22.     SH(1).Parent.Close 0                    '關閉 最新上市股票代號表
  23.     IE.Quit                                 '關閉 網頁
  24.     Set IE = Nothing
  25.     Set Rng = Nothing
  26.     MsgBox "全部日報表下載完成 費時" & Format(T - Time, "HH時mm分ss秒") & Chr(10) & xLMsg
  27.     If xLMsg <> "" Then 無報表紀錄
  28. End Sub
  29. Sub 查詢股票日報表()                        '查詢單一股票日報表
  30.     Dim 股票代號 As String, 股票 As String, T As Date
  31.     存檔資料夾
  32.     xLMsg = ""
  33.     Do While 股票代號 = ""
  34.         股票代號 = InputBox("股票代號", "輸入查詢之股票代號", "1101")
  35.         If 股票代號 = "" Then End
  36.     Loop
  37.     T = Time
  38.     網頁
  39.     匯入日報表 股票代號
  40.     IE.Quit
  41.     Set IE = Nothing
  42.     If xLMsg <> "" Then
  43.         MsgBox xLMsg
  44.         無報表紀錄
  45.         Exit Sub
  46.     Else
  47.         股票 = Replace(Replace(xltheCsv, ".CSV", ""), xlPath, "")
  48.         MsgBox 股票 & Chr(10) & "下載時間" & Format(T - Time, "HH時mm分ss秒") _
  49.         & Chr(10) & "存檔路徑: " & xlPath
  50.     End If
  51.     Workbooks.Open xltheCsv
  52.     ActiveSheet.Cells.EntireColumn.AutoFit
  53. End Sub
  54. Private Sub 匯入日報表(股票代號 As String)      '處裡傳送來的 --股票代號--
  55.     Dim Xall As Integer, SubMsg As String, SubRng As Range
  56.     Xall = Val(報表頁數(股票代號))              '傳回報表頁數
  57.     If Xall = 0 Then                            '無報表頁數: 報表不存在
  58.         If Rng Is Nothing Then
  59.             SubMsg = "[ " & 股票代號 & " ] 無報表"
  60.         Else                                    '全部日報表程式: 含股票名稱
  61.             SubMsg = Rng & " 無報表"
  62.         End If
  63.         xLMsg = IIf(xLMsg <> "", xLMsg & Chr(10) & SubMsg, SubMsg)
  64.         Exit Sub
  65.     End If
  66.     Set SH(2) = Workbooks.Add(1).Sheets(1)       '新增一活頁簿
  67.     With SH(2).QueryTables.Add(Connection:="URl;http://bsr.twse.com.tw/bshtm/bsContent.aspx?StartNumber=" & 股票代號 & "&FocusIndex=All_" & Xall, Destination:=SH(2).Range("A1"))
  68.             .WebFormatting = xlWebFormattingNone
  69.             .WebTables = "4,""table2"""
  70.             On Error Resume Next                '程式還有錯誤不處裡
  71.             Do
  72.             Err.Clear                           '清除錯誤值
  73.             .Refresh BackgroundQuery:=False     'Refresh 失敗 會有錯誤值
  74.             Loop While Err > 0                  '有錯誤值繼續迴圈 直到  Refresh 成功
  75.             On Error GoTo 0                     '有錯誤值 不處裡
  76.             '消除: On Error Resume Next 如還有錯誤不處裡 會影響運行的正確性
  77.             SH(2).Names(.Name).Delete
  78.     End With
  79.     If Xall > 1 Then                              '處裡頁數 > 1  '清理空白列及 每頁的欄位
  80.         With SH(2)
  81.             Set SubRng = .Range(.[A6], .Cells(.Rows.Count, "A").End(xlUp))
  82.             SubRng.Replace "序", "", xlWhole
  83.             SubRng.SpecialCells(xlCellTypeBlanks).EntireRow.Delete xlUp
  84.         End With
  85.     End If
  86.     xltheCsv = xlPath & Format(SH(2).[B1], "yyyy_mm_dd ") & SH(2).[F1] & ".CSV"
  87.     On Error GoTo xlerr                             'xltheCsv  已開啟會有錯誤  到xLerr處裡
  88.     If Dir(xltheCsv) <> "" Then Kill xltheCsv
  89.     On Error GoTo 0
  90.     SH(2).Parent.SaveAs xltheCsv, xlCsv
  91.     SH(2).Parent.Close True
  92.     Exit Sub
  93. xlerr:
  94. If Err = 70 Then
  95.     Workbooks(Format(SH(2).[B1], "yyyy_mm_dd ") & SH(2).[F1] & ".CSV").Close 0   '關閉xltheCsv 可清除錯誤
  96.     Resume                                                                       '反回錯誤行
  97. Else
  98.     MsgBox "錯誤值 " & Err & " 需偵錯!!"
  99.     End
  100. End If
  101. End Sub
  102. Private Sub 上市股票代號()  '下載最新代號 ( 上市股票,上市認購(售)權證,受益證券-不動產投資信託 )
  103.     Dim SstockId  As String
  104.     SstockId = "URL;http://brk.twse.com.tw:8000/isin/C_public.jsp?strMode=2"
  105.     Set SH(1) = Workbooks.Add(1).Sheets(1)
  106.     With SH(1).QueryTables.Add(SstockId, SH(1).[A1])
  107.         .WebFormatting = xlWebFormattingNone
  108.         .WebTables = "2"
  109.         .Refresh 0
  110.     End With
  111. End Sub
  112. Private Sub 網頁()             '開啟網頁
  113.     Dim Url As String
  114.     Set IE = CreateObject("InternetExplorer.Application")
  115.     Url = "http://bsr.twse.com.tw/bshtm/bsMenu.aspx"
  116.     With IE
  117.         '.Visible = False   ''可以不顯示 IE
  118.           .Visible = True
  119.         .Navigate "http://bsr.twse.com.tw/bshtm/bsMenu.aspx"
  120.         Do While .Busy Or .ReadyState <> 4
  121.             DoEvents
  122.         Loop
  123.     End With
  124. End Sub
  125. Private Sub 存檔資料夾()     '沒有CSV存檔的路徑: 設立CSV存檔的路徑
  126.     If Dir(xlPath, vbDirectory) = "" Then MkDir xlPath
  127. End Sub
  128. Private Sub 無報表紀錄()   '工作表上紀錄 沒報表的股票代號
  129.     With ThisWorkbook.Sheets(1)
  130.         .Activate
  131.         If .[A1] = "" Then .[A1] = "股票: 無報表"
  132.         .Cells(.Rows.Count, "a").End(xlUp).Offset(1).Resize(UBound(Split(xLMsg, Chr(10))) + 1) = Application.Transpose(Split(xLMsg, Chr(10)))
  133.     End With
  134. End Sub
  135. Private Function 報表頁數(Sstock_N0 As String)
  136.     Dim element As Object
  137.     On Error GoTo xlerr:
  138. xlAgain:
  139.     Set element = IE.Document.getElementsByName("txtTASKNO")
  140.     element.Item(0).Value = Sstock_N0
  141.     Set element = IE.Document.getElementsByName("btnOK")
  142.     element.Item(0).Click
  143.     With IE
  144.         Do While .Busy Or .ReadyState <> 4
  145.             DoEvents
  146.         Loop
  147.     End With
  148.     Set element = IE.Document.getElementsByName("sp_ListCount")
  149.     報表頁數 = element.Item(0).innertext
  150.     Exit Function
  151. xlerr:        '處裡網頁中斷
  152.     IE.Quit
  153.     網頁
  154.     Err.Clear
  155.     GoTo xlAgain
  156. End Function
複製代碼

TOP

回復 7# GBKEE


    好棒!執行速度超快的!
報告:
目前有個中斷點在代號1414
??

TOP

回復 8# HSIEN6001


    附註斷點:    報表頁數 = element.Item(0).innertext

TOP

回復 7# GBKEE


    你好,完整excel檔案可以分享嗎?謝謝。
devidlin

TOP

        靜思自在 : 滴水成河。粒米成蘿,勿輕己靈,勿以善小而不為。
返回列表 上一主題