Excel精英培训网

 找回密码
 注册
数据透视表40+个常用小技巧,让你一次学会!
查看: 6467|回复: 21

[已解决](未解决,求管理别再改主题分类)(原来代码已失效,再求助)从网页提取数据不成功,跪求

[复制链接]
发表于 2017-5-20 09:52 | 显示全部楼层 |阅读模式
本帖最后由 staynam 于 2017-8-7 09:29 编辑

8月3日更新
之前给的代码突然失效,但是我用httpfox嗅探地址发现真实地址并未改变,跪求帮忙。

运行的时候出现如下错误

然后点击调试会跳到         .send    这一行
跪求大大帮忙

其中一个代码如下(因为论坛等级不能发链接,所以我把 url= 后面的 http:// 去掉了)

  1.     Sub test_1()
  2.         Dim url$, strJSON$, objJson, rData
  3.         Dim ar, brr(1000, 30), i%, j%
  4.         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"
  5.         With CreateObject("msxml2.xmlhttp")
  6.             .Open "GET", url, False
  7.             .send
  8.             strJSON = .responsetext
  9.         End With
  10.         With CreateObject("msscriptcontrol.scriptcontrol")
  11.             .Language = "JavaScript"
  12.             .AddCode strJSON
  13.             Set objJson = .CodeObject
  14.         End With
  15.         For Each rData In objJson.rankData.datas
  16.             i = i + 1
  17.             ar = Split(rData, ",")
  18.             For j = 0 To UBound(ar)
  19.                 brr(i, j) = ar(j)
  20.             Next
  21.         Next
  22.         Cells.Clear
  23.         Cells.Font.Size = 9
  24.         [a:a].NumberFormatLocal = "@"
  25.         [a1].Resize(i, UBound(ar)) = brr
  26.         MsgBox "抓取完毕!"
  27.     End Sub
复制代码


以下是原贴
RT,想从网页 fund.eastmoney.com/data/fundranking.html#tgp;c0;r;s1yzf;pn50;ddesc  自动提取数据,
用excel2007自带的 数据 - 自网站 无法正常提取,跪求大神帮忙。(没有权限发超链接,所以只能这样)
如图,想抓取的数据是打钩的这个,
source.png


但是导出以后实际上只能得到以下内容,跪求各路大神帮忙
result.png



最佳答案
2017-5-20 18:47
1,此网站数据为JSON格式,自网站导入数据方式可能行不通。
2,代码已导出全部24列数据,网站实际数据只有17列已包含其中,如需要楼主可添加代码过滤掉无用项。
3,标题未添加。如需要可对应网站与实际数据自行添加。
4,示例数据导出50行,如需更多只需更改“pn”参数。
  1. Sub test_XWZ()
  2.     Dim url$, strJSON$, objJson, rData
  3.     Dim ar, brr(1000, 30), i%, j%
  4.     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"
  5.     With CreateObject("msxml2.xmlhttp")
  6.         .Open "GET", url, False
  7.         .send
  8.         strJSON = .responsetext
  9.     End With
  10.     With CreateObject("msscriptcontrol.scriptcontrol")
  11.         .Language = "JavaScript"
  12.         .AddCode strJSON
  13.         Set objJson = .CodeObject
  14.     End With
  15.     For Each rData In objJson.rankData.datas
  16.         i = i + 1
  17.         ar = Split(rData, ",")
  18.         For j = 0 To UBound(ar)
  19.             brr(i, j) = ar(j)
  20.         Next
  21.     Next
  22.     Cells.Clear
  23.     Cells.Font.Size = 9
  24.     [a:a].NumberFormatLocal = "@"
  25.     [a1].Resize(i, UBound(ar)) = brr
  26.     MsgBox "抓取完毕!"
  27. End Sub
复制代码


天天基金.rar (23.58 KB, 下载次数: 18)
发表于 2017-5-20 18:47 | 显示全部楼层    本楼为最佳答案   
1,此网站数据为JSON格式,自网站导入数据方式可能行不通。
2,代码已导出全部24列数据,网站实际数据只有17列已包含其中,如需要楼主可添加代码过滤掉无用项。
3,标题未添加。如需要可对应网站与实际数据自行添加。
4,示例数据导出50行,如需更多只需更改“pn”参数。
  1. Sub test_XWZ()
  2.     Dim url$, strJSON$, objJson, rData
  3.     Dim ar, brr(1000, 30), i%, j%
  4.     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"
  5.     With CreateObject("msxml2.xmlhttp")
  6.         .Open "GET", url, False
  7.         .send
  8.         strJSON = .responsetext
  9.     End With
  10.     With CreateObject("msscriptcontrol.scriptcontrol")
  11.         .Language = "JavaScript"
  12.         .AddCode strJSON
  13.         Set objJson = .CodeObject
  14.     End With
  15.     For Each rData In objJson.rankData.datas
  16.         i = i + 1
  17.         ar = Split(rData, ",")
  18.         For j = 0 To UBound(ar)
  19.             brr(i, j) = ar(j)
  20.         Next
  21.     Next
  22.     Cells.Clear
  23.     Cells.Font.Size = 9
  24.     [a:a].NumberFormatLocal = "@"
  25.     [a1].Resize(i, UBound(ar)) = brr
  26.     MsgBox "抓取完毕!"
  27. End Sub
复制代码


天天基金.rar (23.58 KB, 下载次数: 18)

评分

参与人数 3 +13 收起 理由
today0427 + 9 来学习
staynam + 1 非常感谢大神,我研究一下
france723 + 3 来学习

查看全部评分

回复

使用道具 举报

 楼主| 发表于 2017-5-25 10:43 | 显示全部楼层
雪舞子 发表于 2017-5-20 18:47
1,此网站数据为JSON格式,自网站导入数据方式可能行不通。
2,代码已导出全部24列数据,网站实际数据只有 ...

大大您好,我根据英文勉强自己得到了各个时间段,和不同基金类型对应的数据网址但我是学金融的没有任何电脑语言基础,
目前只能用蠢办法做5个模块,然后翻到每个tab,再分别运行对应的模块一个个抓取
请问有没有办法集成到一个模块里,以达到一次性同时抓取数个网址的数据到数个Tab,Tab标签是“近1月”,“近3月”,“近6月”,“近1年”,“近2年”






回复

使用道具 举报

发表于 2017-5-27 07:11 | 显示全部楼层
staynam 发表于 2017-5-25 10:43
大大您好,我根据英文勉强自己得到了各个时间段,和不同基金类型对应的数据网址但我是学金融的没有任何电 ...

可以将不同网址写入单元格或数组变量中,然后循环即可。
回复

使用道具 举报

 楼主| 发表于 2017-5-27 15:11 | 显示全部楼层
雪舞子 发表于 2017-5-27 07:11
可以将不同网址写入单元格或数组变量中,然后循环即可。

额 不是很明白如何设置变量,我暂时先在每一个tab设置了按钮以指向不同的宏另外再麻烦大大一次,以下这个网址
fund.eastmoney.com/data/diyfundranking.html#tetf;c0;r;sqjzf;pn50;ddesc;qsd20160527;qed20170527;qdii

用httpfox抓到数据真实地址是
fund.eastmoney.com/data/rankhandler.aspx?op=dy&dt=kf&ft=etf&rs=&gs=0&sc=qjzf&st=desc&sd=2016-05-27&ed=2017-05-27&es=0&qdii=&pi=1&pn=50&dx=0&v=0.9209703669927463
请问通过VBA能自动通过更改sd和ed,以达到,1个月,3个月,6个月,1年,2年(以每次excel这边更新数据的时间为终点)的效果么。
另外请问v=后面的那串数字是干啥的?我去掉&v=0.9209703669927463这整段发现对结果也完全没有影响。

回复

使用道具 举报

发表于 2017-5-27 15:24 | 显示全部楼层
1,可以通过更改sd和ed,以达到,1个月,3个月,6个月,1年,2年(以每次excel这边更新数据的时间为终点)的效果。
设置变量及相应代码更改为:
  1. Dim sd$, ed$, ar
  2.     sd = Format(Date, "yyyy-mm-dd")
  3.     ed = sd: Mid(sd, 1, 4) = Left(sd, 4) - 1
  4.     url = "http://fund.eastmoney.com/data/rankhandler.aspx?op=ph&dt=kf&ft=gp&rs=&gs=0&sc=1yzf&st=desc&sd=" & sd & "&ed=" & ed & "&qdii=&tabSubtype=,,,,,&pi=1&pn=50"
复制代码


2,v=后面的那串数字是随机数,在这里没什么用。
回复

使用道具 举报

 楼主| 发表于 2017-5-31 16:41 | 显示全部楼层
本帖最后由 staynam 于 2017-6-1 21:01 编辑
雪舞子 发表于 2017-5-27 15:24
1,可以通过更改sd和ed,以达到,1个月,3个月,6个月,1年,2年(以每次excel这边更新数据的时间为终点) ...

抱歉,端午节出行去了。
请问您这个是不是弄反了?
ed是电脑的时间
sd是电脑时间往前推1个月,3个月等

  • sd = ed: Mid(ed, 1, 4) = Left(ed, 4) - 1
  • ed = Format(Date, "yyyy-mm-dd")



但是我改成这个又不能用。 -1改成+1也没用
回复

使用道具 举报

发表于 2017-6-3 18:16 | 显示全部楼层
staynam 发表于 2017-5-31 16:41
抱歉,端午节出行去了。
请问您这个是不是弄反了?
ed是电脑的时间

没反。

ed为今天日期,
sd为去年的今天日期。

回复

使用道具 举报

 楼主| 发表于 2017-6-4 17:08 | 显示全部楼层
雪舞子 发表于 2017-6-3 18:16
没反。

ed为今天日期,

那请问大大,如果改成6个月之的要如何改动?非常感谢
回复

使用道具 举报

发表于 2017-6-4 20:47 | 显示全部楼层
staynam 发表于 2017-6-4 17:08
那请问大大,如果改成6个月之的要如何改动?非常感谢

数据已全部抓取出来,只要对着一下网页标题添加一下即可。
jj.jpg
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-3-29 08:16 , Processed in 0.459172 second(s), 17 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表