分享

Excel 如何抓取网址不变的多页数据,浏览了整个论坛没发现相关解答(附相关代码)

 mastereye 2018-01-23
 本帖最后由 xiaokang312135
http://club./thread-1060509-1-1.html

小弟最近因为要用到网站上的相关数据,所以这两天在本论坛上认真学习了网页抓取,但是涉及到翻页且网址不变的内容几乎没有。而我恰恰遇到的就是这个问题。(网址有变化的例如page=?1,2,3...这样的我已经学会了)。废话少说,我还是直接上题目:需要抓取同花顺网站上限售解禁股的表格数据,网址如下http://data.10jqka.com.cn/market/xsjj/ ,我知道论坛上网抓大师不少,真心希望你们出手相助,同时让有相关需求的坛友也能学习到方法。
如果只是一页,我的程序如下(运行成功):
     Sub test()
    Dim ie, dmt, tbs, i&, tb, j&, k&
    Set ie = CreateObject("InternetExplorer.Application")    '创建一个IE对象
    With ie
        .Visible = True    '显示它
        .Navigate "http://data.10jqka.com.cn/market/xsjj/"    '加载某个页面
        Do Until .ReadyState = 4    '等待页面加载完毕
            DoEvents
        Loop
        Set dmt = .Document    '将IE浏览器加载的页面文档,赋予dmt变量
        Set tbs = dmt.All.tags("table")  '获取所有的table对象集合
        For i = 0 To tbs.Length - 1    '历遍每个table
            If InStr(tbs(i).innerText, "限售解禁日期") > 0 Then    '判断它的内含文本是否有某个关键字
                Debug.Print i
                Set tb = tbs(i)    '符合则捕捉这个表
                For j = 0 To tb.Rows.Length - 1 '历遍其每个行
            For k = 0 To tb.Rows(j).Cells.Length - 1 '历遍每行的每个单元格
                Cells(j + 1, k + 1) = tb.Rows(j).Cells(k).innerText '将其innertext写入单元格
            Next
        Next

        End If
        Next
    End With
End Sub
用xmlhttp方法小弟也是可以的,只是多页且网址不变,我逛了两天论坛也没找到相关教程和实例,还望热心坛友帮忙解决


附上xmlhttp方法,供大家参考:
Sub 限售解禁股票()
On Error Resume Next
Dim temp, s
Cells.Clear
[a1:I1] = Split("序号,股票代码,股票简称,限售解禁日期,本期解禁数(万股),收盘价,解禁股市值(万元),占总股本比例(%),限售股东", ",")
With CreateObject("Microsoft.XMLHTTP")
  .Open "Get", "http://data.10jqka.com.cn/market/xsjj/", True
  .send
  Do Until .readystate = 4
    DoEvents
  Loop
  temp = Split(Split(Split(.responsetext, "限售股东")(1), "表格页码")(0), "明细</a></td>")
  For i = 0 To UBound(temp)
    s = Split(temp(i), "</td>")
    Cells(i + 2, 1) = Split(s(0), "tc"">")(1)
    Cells(i + 2, 2) = Split(Split(s(1), "blank"">")(1), "</a>")(0)
    Cells(i + 2, 3) = Split(Split(s(2), "blank"">")(1), "</a>")(0)
    Cells(i + 2, 4) = Split(s(3), "cur"">")(1)
    Cells(i + 2, 5) = Split(s(4), "tc"">")(1)
    Cells(i + 2, 6) = Split(s(5), """>")(1)
    Cells(i + 2, 7) = Split(s(6), "tc"">")(1)
    Cells(i + 2, 8) = Split(s(7), "tc"">")(1)
    Next i
    End With


End Sub


    本站是提供个人知识管理的网络存储空间,所有内容均由用户发布,不代表本站观点。请注意甄别内容中的联系方式、诱导购买等信息,谨防诈骗。如发现有害或侵权内容,请点击一键举报。
    转藏 分享 献花(0

    0条评论

    发表

    请遵守用户 评论公约

    类似文章 更多