暱稱: Raymond Chien
中學生
- 帖子
- 109
- 主題
- 12
- 精華
- 0
- 積分
- 177
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- office2013
- 閱讀權限
- 20
- 性別
- 男
- 來自
- 高雄
- 註冊時間
- 2017-11-19
- 最後登錄
- 2023-7-5
|
回復 9# bhsm - Sub test()
- stockno = InputBox("請輸入股票代號")
- If stockno = "" Then Exit Sub
- Application.ScreenUpdating = False
- [A4].CurrentRegion.Clear
- t = Timer
- Dim myXML As Object
- Set myXML = CreateObject("WinHttp.WinHttpRequest.5.1")
- Dim myHTML As Object
- Set myHTML = CreateObject("HTMLFile")
- myLimit = 10 '近幾筆資料數
- ReDim myDateArr(1 To 60, 1 To 1)
- ReDim myValArr(1 To 25, 1 To myLimit * 5)
- With myXML
- .Open "POST", "https://www.tdcc.com.tw/smWeb/QryStockAjax.do", False '先抓取日期
- .setRequestHeader "Content-type", "application/x-www-form-urlencoded;charset=UTF-8"
- .send "REQ_OPR=qrySelScaDates"
-
- k = 1
- For Each myText2 In Split(.responseText, ",")
- myDateArr(k, 1) = Replace(Replace(Replace(myText2, Chr(34), ""), "[", ""), "]", "")
- k = k + 1
- Next
-
- mycount = 1
- For Each myDate In myDateArr
- retry:
- .Open "POST", "https://www.tdcc.com.tw/smWeb/QryStockAjax.do", False '代入日期撈資料
- .setRequestHeader "Content-type", "application/x-www-form-urlencoded"
- .send "scaDates=" & myDate & "&scaDate=" & myDate & "&SqlMethod=StockNo&StockNo=" & stockno & "&StockName=&REQ_OPR=SELECT&clkStockNo=" & stockno & "&clkStockName="
-
- If InStr(1, .responseText, "無此資料") <> 0 Then GoTo retry
-
- myHTML.body.innerHTML = .responseText
-
- Set mytable = myHTML.getElementsByTagName("table")(7)
-
- i = 1
-
- For Each myRow In mytable.Rows
-
- j = 5 * (myLimit - mycount) + 1
- For Each myCell In myRow.Cells
- myValArr(i, j) = myCell.innerText
- j = j + 1
- Next
- i = i + 1
- Next
- Cells(4, j - 5) = myDate
- Debug.Assert Cells(4, j - 4) = ""
- mycount = mycount + 1
- If mycount = myLimit + 1 Then Exit For '要抓幾筆資料
- Next
- [A3] = "證券名稱：" & Split(Split(.responseText, "證券名稱：")(1), "<")(0)
- [A5].Resize(UBound(myValArr), 5 * myLimit).Value = myValArr
- End With
- Erase myDateArr
- Erase myValArr
- Set myXML = Nothing
- Set myHTML = Nothing
- Debug.Print Format(Timer - t, "0.00秒")
- Application.ScreenUpdating = True
- End Sub
|
|
發表於 2018-3-28 21:51
| 
