[已解决]请帮忙编一个复制网页表格数据的vba代码

另类2011 · 发表于 2015-1-24 14:37

http://data.eastmoney.com/report/ylyc.html
这是东方财富网上个股盈利预测一览表的数据，由于数据页面多，每天都有更新，复制起来很费时间，所以恳请老师们帮忙编一个VBA代码，谢谢！！！！！！！！

最佳答案

月排行榜 / 总排行榜

芐雨

2015-1-24 22:31

Sub 按钮1_Click()
Dim ul$, Str$, i&, j&, x&
Dim arr, br, brr
ReDim brr(1 To 5000, 1 To 17)
ul = "http://nufm.dfcfw.com/EM_Finance2014NumericApplication/JS.aspx?type=CT&cmd=C._A&sty=GEMCPF&st=(AllNum)&sr=-1&p=1&ps=5000&cb=&js=var%20wdWUVlLp={%22data%22:[(x)],%22pages%22:%22(pc)%22}&token=3a965a43f705cf1d9ad7e1a3e429d622&rt=47403574"
Str = GetSource(ul)
arr = Split(Split(Str, "={""data"":[""")(1), """,""") '将结果拆分放入数组
For i = 0 To UBound(arr)
x = x + 1
br = Split(arr(i), ",")
For j = 1 To 17
brr(x, j) = br(j)
Next
Next
ActiveSheet.UsedRange.Offset(2).ClearContents
[D:D].NumberFormat = "@"
Range("D3").Resize(x, 17) = brr
End Sub
Private Function GetSource(sURL As String) As String
Dim oXHTTP As Object
Set oXHTTP = CreateObject("MSXML2.XMLHTTP") '创建xmlhttp用于读取网页源代码
oXHTTP.Open "GET", sURL, False '获取对应页源代码
oXHTTP.Send '发送请求
GetSource = oXHTTP.responsetext '提取返回的网页源代码
Set oXHTTP = Nothing
End Function

复制代码

附件：

网页取数.zip (18.5 KB, 下载次数: 19)

芐雨 · 发表于 2015-1-24 22:31

Sub 按钮1_Click()
Dim ul$, Str$, i&, j&, x&
Dim arr, br, brr
ReDim brr(1 To 5000, 1 To 17)
ul = "http://nufm.dfcfw.com/EM_Finance2014NumericApplication/JS.aspx?type=CT&cmd=C._A&sty=GEMCPF&st=(AllNum)&sr=-1&p=1&ps=5000&cb=&js=var%20wdWUVlLp={%22data%22:[(x)],%22pages%22:%22(pc)%22}&token=3a965a43f705cf1d9ad7e1a3e429d622&rt=47403574"
Str = GetSource(ul)
arr = Split(Split(Str, "={""data"":[""")(1), """,""") '将结果拆分放入数组
For i = 0 To UBound(arr)
x = x + 1
br = Split(arr(i), ",")
For j = 1 To 17
brr(x, j) = br(j)
Next
Next
ActiveSheet.UsedRange.Offset(2).ClearContents
[D:D].NumberFormat = "@"
Range("D3").Resize(x, 17) = brr
End Sub
Private Function GetSource(sURL As String) As String
Dim oXHTTP As Object
Set oXHTTP = CreateObject("MSXML2.XMLHTTP") '创建xmlhttp用于读取网页源代码
oXHTTP.Open "GET", sURL, False '获取对应页源代码
oXHTTP.Send '发送请求
GetSource = oXHTTP.responsetext '提取返回的网页源代码
Set oXHTTP = Nothing
End Function

复制代码

附件：

网页取数.zip (18.5 KB, 下载次数: 19)

另类2011 · 发表于 2015-1-25 09:20

芐雨发表于 2015-1-24 22:31
附件：

很好用，谢谢芐雨老师！还有请问一下这个链接网址是怎么取得的：
"http://nufm.dfcfw.com/EM_Finance2014NumericApplication/JS.aspx?type=CT&cmd=C._A&sty=GEMCPF&st=(AllNum)&sr=-1&p=1&ps=5000&cb=&js=var%20wdWUVlLp={%22data%22:[(x)],%22pages%22:%22(pc)%22}&token=3a965a43f705cf1d9ad7e1a3e429d622&rt=47403574"
不吝赐教，谢谢！！！！！！！

芐雨 · 发表于 2015-1-25 09:21

另类2011 发表于 2015-1-25 09:20
很好用，谢谢芐雨老师！还有请问一下这个链接网址是怎么取得的：
"http://nufm.dfcfw.com/EM_Finance201 ...

用Fiddler 找到的取数的实际地址。

另类2011 · 发表于 2015-1-25 09:35

芐雨发表于 2015-1-25 09:21
用Fiddler 找到的取数的实际地址。

谢谢芐雨老师！好人一生平安！！！！！！！！！

		自动登录	找回密码
密码			注册

[已解决]请帮忙编一个复制网页表格数据的vba代码

评分

评分