小白急求下载网站表格数据

destroyingking

我想下载http://data.eastmoney.com/soft_new/bbsj/201412/yysj/gpdm/1.html网站上的数据，有53页，要是一页一页粘贴复制，得累死了，求高手指点~~

jsxjd

每页地址都是按序号编码的

destroyingking

jsxjd 发表于 2015-3-23 11:16
每页地址都是按序号编码的

是的，我现在的笨方法是每页都用迅雷下载，然后导入excel

jsxjd

destroyingking 发表于 2015-3-23 11:37
是的，我现在的笨方法是每页都用迅雷下载，然后导入excel

数据还是比较规范的，可以用VBA提取

destroyingking

jsxjd 发表于 2015-3-23 11:51
数据还是比较规范的，可以用VBA提取

版主，请明示啊，具体怎么操作

onlycxb

Sub 宏1()
    Cells.Clear
    With ActiveSheet.QueryTables.Add(Connection:="URL;http://data.eastmoney.com/soft_new/bbsj/201412/yysj/gpdm/1.html", Destination:=Range("$A$1"))
        .Refresh BackgroundQuery:=False
    End With
End Sub

VBA万岁

Sub test()
Dim html, r, p%, i%, j%
Dim objhq As New MSXML2.XMLHTTP
Cells.Clear
With objhq
    For p = 1 To 3
        .Open "GET", "http://data.eastmoney.com/soft_new/bbsj/201412/yysj/gpdm/" & p & ".html", False
        .send
        Set html = CreateObject("htmlfile")
        html.Body.innerhtml = .responseText
        Set r = html.all.tags("table")(0).Rows
        For i = 0 To r.Length - 1
            For j = 0 To r(i).Cells.Length - 1
                Cells((p - 1) * 50 + i + 1, j + 1) = r(i).Cells(j).innertext
            Next j
        Next i
    Next p
End With
End Sub

VBA万岁

网络故障？重复回帖，清除。

VBA万岁

VBA万岁 发表于 2015-3-23 16:40
Sub test()
Dim html, r, p%, i%, j%
Dim objhq As New MSXML2.XMLHTTP

什么毛病啊？——最近发贴老是弹出如下提示而阻碍发贴：

VBA万岁

onlycxb 发表于 2015-3-23 15:40
Sub 宏1()
    Cells.Clear
    With ActiveSheet.QueryTables.Add(Connection:="URL;http://data.eastmo ...

加一个循环查询多页数据：

1. Sub 宏1()
   
2. Cells.Clear
   
3. For p = 1 To 3
   
4.     With ActiveSheet.QueryTables.Add(Connection:="URL;http://data.eastmoney.com/soft_new/bbsj/201412/yysj/gpdm/" & p & ".html", Destination:=Range("$A$" & (p - 1) * 51 + 1))
   
5.         .Refresh BackgroundQuery:=False
   
6.     End With
   
7. Next p
   
8. End Sub

复制代码

QueryTable法提取数据.zip (43.24 KB, 下载次数: 14)

2015-3-24 08:46 上传

点击文件名下载附件