iamaraymond

回復 9# bhsm

1. Sub test()
   
2. 
   
3. stockno = InputBox("請輸入股票代號")
   
4. If stockno = "" Then Exit Sub
   
5. Application.ScreenUpdating = False
   
6. [A4].CurrentRegion.Clear
   
7. 
   
8. t = Timer
   
9. 
   
10. Dim myXML As Object
    
11. Set myXML = CreateObject("WinHttp.WinHttpRequest.5.1")
    
12. 
    
13. Dim myHTML As Object
    
14. Set myHTML = CreateObject("HTMLFile")
    
15. 
    
16. myLimit = 10 '近幾筆資料數
    
17. 
    
18. ReDim myDateArr(1 To 60, 1 To 1)
    
19. ReDim myValArr(1 To 25, 1 To myLimit * 5)
    
20. 
    
21. With myXML
    
22.     .Open "POST", "https://www.tdcc.com.tw/smWeb/QryStockAjax.do", False    '先抓取日期
    
23.     .setRequestHeader "Content-type", "application/x-www-form-urlencoded;charset=UTF-8"
    
24.     .send "REQ_OPR=qrySelScaDates"
    
25.    
    
26.     k = 1
    
27.     For Each myText2 In Split(.responseText, ",")
    
28.         myDateArr(k, 1) = Replace(Replace(Replace(myText2, Chr(34), ""), "[", ""), "]", "")
    
29.         k = k + 1
    
30.     Next
    
31.    
    
32.     mycount = 1
    
33.     For Each myDate In myDateArr
    
34. retry:
    
35.         .Open "POST", "https://www.tdcc.com.tw/smWeb/QryStockAjax.do", False    '代入日期撈資料
    
36.         .setRequestHeader "Content-type", "application/x-www-form-urlencoded"
    
37.         .send "scaDates=" & myDate & "&scaDate=" & myDate & "&SqlMethod=StockNo&StockNo=" & stockno & "&StockName=&REQ_OPR=SELECT&clkStockNo=" & stockno & "&clkStockName="
    
38.         
    
39.         If InStr(1, .responseText, "無此資料") <> 0 Then GoTo retry
    
40.         
    
41.         myHTML.body.innerHTML = .responseText
    
42.         
    
43.         Set mytable = myHTML.getElementsByTagName("table")(7)
    
44.         
    
45.         i = 1
    
46.         
    
47.         For Each myRow In mytable.Rows
    
48.             
    
49.              j = 5 * (myLimit - mycount) + 1
    
50.             For Each myCell In myRow.Cells
    
51.                 myValArr(i, j) = myCell.innerText
    
52.                 j = j + 1
    
53.             Next
    
54.             i = i + 1
    
55.         Next
    
56.         Cells(4, j - 5) = myDate
    
57.         Debug.Assert Cells(4, j - 4) = ""
    
58.         mycount = mycount + 1
    
59.         If mycount = myLimit + 1 Then Exit For '要抓幾筆資料
    
60.     Next
    
61. [A3] = "證券名稱：" & Split(Split(.responseText, "證券名稱：")(1), "<")(0)
    
62. [A5].Resize(UBound(myValArr), 5 * myLimit).Value = myValArr
    
63. 
    
64. End With
    
65. 
    
66. Erase myDateArr
    
67. Erase myValArr
    
68. Set myXML = Nothing
    
69. Set myHTML = Nothing
    
70. 
    
71. Debug.Print Format(Timer - t, "0.00秒")
    
72. Application.ScreenUpdating = True
    
73. End Sub

複製代碼

試看看這個吧~

iamaraymond

回復 10# quickfixer

這個文之前我也有看過，Snare大的程式當然比我這種門外漢強很多XD
只是我比較習慣把每一周都列出來，所以若您有興趣的話可以看看我剛剛新放上去的貼文
至於速度在其他條件差不多的情況下，主要是取決於發了多少Request，在他的code中只抓了2個禮拜的資料，但我抓了10個禮拜的，所以速度會比較慢

iamaraymond

回復 7# cji3cj6xu6


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

至於要跳著抓其實方法很多，例如用if設定計數器0和1，當等於1時才抓
或是判斷L是不是偶數之類的

quickfixer

回復 12# iamaraymond


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

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

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

iamaraymond

回復 14# quickfixer

你們的錯誤是不是"安全通道支援發生錯誤 "?
如果是的話，我之前好像有看到有個解決方法是
打開註冊表(搜尋regedit)
   

下載 (20.49 KB)

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

quickfixer

回復 2# joey0415

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

cji3cj6xu6

回復 15# iamaraymond


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

謝謝~~

bhsm

回復 11# iamaraymond
謝謝iamaraymond大

BANK870

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

peter95

回復 2# joey0415

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

想請大大幫忙  教教小弟
非常感謝您的幫忙
謝謝