|
本帖最后由 staynam 于 2017-8-7 09:29 编辑
8月3日更新
之前给的代码突然失效,但是我用httpfox嗅探地址发现真实地址并未改变,跪求帮忙。
运行的时候出现如下错误
然后点击调试会跳到 .send 这一行
跪求大大帮忙
其中一个代码如下(因为论坛等级不能发链接,所以我把 url= 后面的 http:// 去掉了)
- Sub test_1()
- Dim url$, strJSON$, objJson, rData
- Dim ar, brr(1000, 30), i%, j%
- url = "fund.eastmoney.com/data/rankhandler.aspx?op=ph&dt=kf&ft=qdii&rs=&gs=0&sc=1yzf&st=desc&qdii=&tabSubtype=,,,,,&pi=1&pn=51"
- With CreateObject("msxml2.xmlhttp")
- .Open "GET", url, False
- .send
- strJSON = .responsetext
- End With
- With CreateObject("msscriptcontrol.scriptcontrol")
- .Language = "JavaScript"
- .AddCode strJSON
- Set objJson = .CodeObject
- End With
- For Each rData In objJson.rankData.datas
- i = i + 1
- ar = Split(rData, ",")
- For j = 0 To UBound(ar)
- brr(i, j) = ar(j)
- Next
- Next
- Cells.Clear
- Cells.Font.Size = 9
- [a:a].NumberFormatLocal = "@"
- [a1].Resize(i, UBound(ar)) = brr
- MsgBox "抓取完毕!"
- End Sub
复制代码
以下是原贴
RT,想从网页 fund.eastmoney.com/data/fundranking.html#tgp;c0;r;s1yzf;pn50;ddesc 自动提取数据,
用excel2007自带的 数据 - 自网站 无法正常提取,跪求大神帮忙。(没有权限发超链接,所以只能这样)
如图,想抓取的数据是打钩的这个,
但是导出以后实际上只能得到以下内容,跪求各路大神帮忙
1,此网站数据为JSON格式,自网站导入数据方式可能行不通。
2,代码已导出全部24列数据,网站实际数据只有17列已包含其中,如需要楼主可添加代码过滤掉无用项。
3,标题未添加。如需要可对应网站与实际数据自行添加。
4,示例数据导出50行,如需更多只需更改“pn”参数。
- Sub test_XWZ()
- Dim url$, strJSON$, objJson, rData
- Dim ar, brr(1000, 30), i%, j%
- url = "http://fund.eastmoney.com/data/rankhandler.aspx?op=ph&dt=kf&ft=gp&rs=&gs=0&sc=1yzf&st=desc&sd=2016-05-20&ed=2017-05-20&qdii=&tabSubtype=,,,,,&pi=1&pn=50"
- With CreateObject("msxml2.xmlhttp")
- .Open "GET", url, False
- .send
- strJSON = .responsetext
- End With
- With CreateObject("msscriptcontrol.scriptcontrol")
- .Language = "JavaScript"
- .AddCode strJSON
- Set objJson = .CodeObject
- End With
- For Each rData In objJson.rankData.datas
- i = i + 1
- ar = Split(rData, ",")
- For j = 0 To UBound(ar)
- brr(i, j) = ar(j)
- Next
- Next
- Cells.Clear
- Cells.Font.Size = 9
- [a:a].NumberFormatLocal = "@"
- [a1].Resize(i, UBound(ar)) = brr
- MsgBox "抓取完毕!"
- End Sub
复制代码
天天基金.rar
(23.58 KB, 下载次数: 18)
|
|