返回列表 上一主題 發帖

[原創] 集保資料(改版後)

回復 9# bhsm
  1. Sub test()

  2. stockno = InputBox("請輸入股票代號")
  3. If stockno = "" Then Exit Sub
  4. Application.ScreenUpdating = False
  5. [A4].CurrentRegion.Clear

  6. t = Timer

  7. Dim myXML As Object
  8. Set myXML = CreateObject("WinHttp.WinHttpRequest.5.1")

  9. Dim myHTML As Object
  10. Set myHTML = CreateObject("HTMLFile")

  11. myLimit = 10 '近幾筆資料數

  12. ReDim myDateArr(1 To 60, 1 To 1)
  13. ReDim myValArr(1 To 25, 1 To myLimit * 5)

  14. With myXML
  15.     .Open "POST", "https://www.tdcc.com.tw/smWeb/QryStockAjax.do", False    '先抓取日期
  16.     .setRequestHeader "Content-type", "application/x-www-form-urlencoded;charset=UTF-8"
  17.     .send "REQ_OPR=qrySelScaDates"
  18.    
  19.     k = 1
  20.     For Each myText2 In Split(.responseText, ",")
  21.         myDateArr(k, 1) = Replace(Replace(Replace(myText2, Chr(34), ""), "[", ""), "]", "")
  22.         k = k + 1
  23.     Next
  24.    
  25.     mycount = 1
  26.     For Each myDate In myDateArr
  27. retry:
  28.         .Open "POST", "https://www.tdcc.com.tw/smWeb/QryStockAjax.do", False    '代入日期撈資料
  29.         .setRequestHeader "Content-type", "application/x-www-form-urlencoded"
  30.         .send "scaDates=" & myDate & "&scaDate=" & myDate & "&SqlMethod=StockNo&StockNo=" & stockno & "&StockName=&REQ_OPR=SELECT&clkStockNo=" & stockno & "&clkStockName="
  31.         
  32.         If InStr(1, .responseText, "無此資料") <> 0 Then GoTo retry
  33.         
  34.         myHTML.body.innerHTML = .responseText
  35.         
  36.         Set mytable = myHTML.getElementsByTagName("table")(7)
  37.         
  38.         i = 1
  39.         
  40.         For Each myRow In mytable.Rows
  41.             
  42.              j = 5 * (myLimit - mycount) + 1
  43.             For Each myCell In myRow.Cells
  44.                 myValArr(i, j) = myCell.innerText
  45.                 j = j + 1
  46.             Next
  47.             i = i + 1
  48.         Next
  49.         Cells(4, j - 5) = myDate
  50.         Debug.Assert Cells(4, j - 4) = ""
  51.         mycount = mycount + 1
  52.         If mycount = myLimit + 1 Then Exit For '要抓幾筆資料
  53.     Next
  54. [A3] = "證券名稱:" & Split(Split(.responseText, "證券名稱:")(1), "<")(0)
  55. [A5].Resize(UBound(myValArr), 5 * myLimit).Value = myValArr

  56. End With

  57. Erase myDateArr
  58. Erase myValArr
  59. Set myXML = Nothing
  60. Set myHTML = Nothing

  61. Debug.Print Format(Timer - t, "0.00秒")
  62. Application.ScreenUpdating = True
  63. End Sub
複製代碼
試看看這個吧~
Excel VBA網頁資料收集教學:
http://forum.twbts.com/thread-20848-1-1.html

TOP

本帖最後由 iamaraymond 於 2018-3-28 22:02 編輯

回復 10# quickfixer

這個文之前我也有看過,Snare大的程式當然比我這種門外漢強很多XD
只是我比較習慣把每一周都列出來,所以若您有興趣的話可以看看我剛剛新放上去的貼文
至於速度在其他條件差不多的情況下,主要是取決於發了多少Request,在他的code中只抓了2個禮拜的資料,但我抓了10個禮拜的,所以速度會比較慢
Excel VBA網頁資料收集教學:
http://forum.twbts.com/thread-20848-1-1.html

TOP

回復 7# cji3cj6xu6


問題1:我剛剛新上傳了Code,可以參考看看
問題2:因為我沒遇到這個狀況,所以不確定

至於要跳著抓其實方法很多,例如用if設定計數器0和1,當等於1時才抓
或是判斷L是不是偶數之類的
Excel VBA網頁資料收集教學:
http://forum.twbts.com/thread-20848-1-1.html

TOP

本帖最後由 quickfixer 於 2018-3-28 22:11 編輯

回復 12# iamaraymond


   他看起來像是股票門外漢 :lol
速度的話,他244樓有玩過一個8開excel , 20多秒就抓玩3千多筆集保資料 XD
可惜網站改版後,他沒更新,那個範例沒辦法玩了

你的程式多加上on error goto或是on error resume 會比較好
cji3cj6xu6  的問題2 ,我也有遇到

最近網站會突然出現什麼安全性連線錯誤的
在這一行就會出錯
.send "REQ_OPR=qrySelScaDates"

TOP

本帖最後由 iamaraymond 於 2018-3-28 22:21 編輯

回復 14# quickfixer

你們的錯誤是不是"安全通道支援發生錯誤 "?
如果是的話,我之前好像有看到有個解決方法是
打開註冊表(搜尋regedit)
   
擷取.JPG
2018-3-28 22:17


然後依據電腦情況
(for Windows 7 64 bits)
[HKEY_LOCAL_MACHINE\SOFTWARE\Wow6432Node\Microsoft\Windows\CurrentVersion\Internet Settings\WinHttp]
"DefaultSecureProtocols"=dword:00000a00

(for Windows 7 32 bits)
[HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Internet Settings\WinHttp]
"DefaultSecureProtocols"=dword:00000a00

參考看看

增加速度還有個方法是用陣列,速度真的差很多,原本要跑3,4秒的東西都只要0.X秒就好了XD
Excel VBA網頁資料收集教學:
http://forum.twbts.com/thread-20848-1-1.html

TOP

回復 2# joey0415

謝謝你分享這,2015年就有的網站,今天才知道原來有整理好的資料可以下載
    https://data.gov.tw/dataset/11452

TOP

回復 15# iamaraymond


試過了,一開始找不到DefaultSecureProtocols,安裝了修正程式後找到它,但依舊有同樣的問題,不用管它了。

謝謝~~

TOP

回復 11# iamaraymond
謝謝iamaraymond大
年齡不小,但我很想學

TOP

請問若需要更改為集保大於400張以上趨勢比較該如何變更

TOP

回復 2# joey0415

小弟不才 想請問 我將檔案抓下來了
但小弟不知如何 彙整
小弟想彙整
1000張以上的比例
200張以下的比例

想請大大幫忙  教教小弟
非常感謝您的幫忙
謝謝
學習 學習 一直學習

TOP

        靜思自在 : 人要知福、惜福、再造福。
返回列表 上一主題