VBA自動抓取finance.yahoo - Excel程式區

11^# 跳轉到 »

發表於 2018-6-17 15:40 | 只看該作者

本帖最後由 f3202 於 2018-6-17 15:43 編輯

回復 8# iamaraymond

a99之後股名下載不到
謝謝

12^#

發表於 2018-6-17 17:50 | 只看該作者

回復 2# f3202

Very Nice code! Thank you very much!

13^#

發表於 2018-6-17 20:17 | 只看該作者

请教这个指标可以用vba提取吗？

这里真是高手云集，以前一些以为没法用VBA提取的资料原来是可以的！那么请教下面这个网站的RSI数据可以用vba自动提取吗？谢谢！

http://www.aastocks.com/tc/stock/detailchart.aspx?symbol=110000#GTop

　暱稱: Raymond Chien

14^#

發表於 2018-6-18 10:28 | 只看該作者

回復 9# f3202

這應該可以使用您在另外一個帖子回的
http://forum.twbts.com/redirect. ... 3&fromuid=30076
xmlhttp+htmlfile來抓到

Excel VBA網頁資料收集教學:
http://forum.twbts.com/thread-20848-1-1.html

15^#

發表於 2018-6-18 10:38 | 只看該作者

回復 10# iamaraymond

9樓的圖是那個程式下載加變碼的
謝謝

　暱稱: Raymond Chien

16^#

發表於 2018-6-18 12:49 | 只看該作者

回復 11# f3202

試試看

Sub test()
Dim t: t = Timer
Cells.Clear
Dim myXML As Object
Set myXML = CreateObject("Microsoft.XMLHTTP")
Dim myHTML As Object
Set myHTML = CreateObject("HTMLFile")
With myXML
.Open "GET", "https://djinfo.cathaysec.com.tw/z/ze/zef/zef.djhtm", False
.send
myHTML.body.innerHTML = convertraw(.responseBody)
Set myTrs = myHTML.getElementsByTagName("table")(2).getElementsByTagName("tbody")(0).getElementsByTagName("tr")
ReDim myArr(1 To myTrs.Length + 1, 1 To 4)
i = 1
For Each myTr In myTrs
Set myTds = myTr.getElementsByTagName("td")
j = 1
For Each myTd In myTds
myArr(i, j) = myTd.innerText
If myTd.innerText = "" Then
myArr(i, j) = Right(Split(Split(Split(myTd.innerHTML, "GenLink2stk(")(1), "')")(0), "'")(1), 4) & Split(Split(Split(myTd.innerHTML, "GenLink2stk(")(1), "')")(0), "'")(3)
End If
j = j + 1
Next
i = i + 1
Next
End With
Range("A1").Resize(UBound(myArr, 1), 4).Value = myArr
Range("A1").WrapText = False
Set myXML = Nothing
Application.StatusBar = "抓取完畢，共花費" & Format(Timer - t, "0.00秒")
End Sub
Function convertraw(rawdata)
Dim rawstr
Set rawstr = CreateObject("adodb.stream")
With rawstr
.Type = 1
.Mode = 3
.Open
.Write rawdata
.Position = 0
.Type = 2
'繁體通常轉成big5就可以了，簡體通常是gb2312
.Charset = "big5"
convertraw = .ReadText
.Close
End With
Set rawstr = Nothing
End Function