网爬程序纠错

sjvkik

Sub cc()
    Dim arr(1 To 100000, 1 To 16)
    Cells.ClearContents
    Set oDoc = CreateObject("htmlfile")
    [a1:d1] = Array("序号", "股票代码", "股票简称", "销售毛利率" & Chr(10) & "%")
    With CreateObject("MSXML2.XMLHTTP")
        For p = 1 To 73
            .Open "GET", "http://data.eastmoney.com/bbsj/201803/yjbb.html", False
            .Send
            oDoc.body.innerHTML = StrConv(.responsebody, vbUnicode)
            Set r = oDoc.All.tags("table")(0).Rows
            For i = 0 To r.Length - 1
                k = k + 1
                For x = 1 To 16
                    arr(k, x) = r(i).Cells(x - 1).innerText
                Next
            Next
            Set r = Nothing
        Next
    End With
    Range("A2").Resize(k, 6) = arr
End Sub

哪位给看看上面程序有什么问题哦

sjvkik

各位大侠给看看呗

phsu

P循環裡面沒看到P。等於跑了73圈相同的循環。

hehex

东方财富网，以前抓过。
你抓的网页是个假的，只是一个展示窗体，永远显示第一页，真实是用下面的页面的数据不停的替换它的内容。你明显没有做抓包分析。
真实的数据是返回一个JSON
地址在：http://dcfm.eastmoney.com/em_mut ... ;js=var%20CMCIRQmO={pages:(tp),data:%20(x)}&filter=(securitytypecode%20in%20(%27058001001%27,%27058001002%27))(reportdate=^2018-03-31^)&rt=50981971
这是以第2页为例，而且这个url 是可以减短的，看到里面的参数了？p=2 把它进行1-73迭代就可以了。
返回的数据是个Json 的数组，想办法处理下面的js 就可以得到你要的数据了。

sjvkik

多谢，可还是看不懂啊
Sub cc()
    Dim arr(1 To 100000, 1 To 16)
    Cells.ClearContents
    Set oDoc = CreateObject("htmlfile")
    [a1:d1] = Array("序号", "股票代码", "股票简称", "销售毛利率" & Chr(10) & "%")
    With CreateObject("MSXML2.XMLHTTP")
        For j = 1 To 73
            .Open "GET", "http://dcfm.eastmoney.com/em_mutisvcexpandinterface/api/js/get?type=YJBB20_YJBB&token=70f12f2f4f091e459a279469fe49eca5&st=latestnoticedate&sr=-1&p=j&ps=50&js=var%20CMCIRQmO=", False
            .Send
            oDoc.body.innerHTML = StrConv(.responsebody, vbUnicode)
            Set r = oDoc.All.tags("table")(0).Rows
            For i = 0 To r.Length - 1
                k = k + 1
                For x = 1 To 16
                    arr(k, x) = r(i).Cells(x - 1).innerText
                Next
            Next
            Set r = Nothing
        Next
    End With
    Range("A2").Resize(k, 6) = arr
End Sub

sjvkik

hehex 发表于 2018-6-20 10:05
东方财富网，以前抓过。
你抓的网页是个假的，只是一个展示窗体，永远显示第一页，真实是用下面的页面的数 ...

Sub cc()
    Dim arr(1 To 100000, 1 To 16)
    Cells.ClearContents
    Set oDoc = CreateObject("htmlfile")
    [a1:d1] = Array("序号", "股票代码", "股票简称", "销售毛利率" & Chr(10) & "%")
    With CreateObject("MSXML2.XMLHTTP")
        For j = 1 To 73
            .Open "GET", "http://dcfm.eastmoney.com/em_mutisvcexpandinterface/api/js/get?type=YJBB20_YJBB&token=70f12f2f4f091e459a279469fe49eca5&st=latestnoticedate&sr=-1&p=j&ps=50&js=var%20CMCIRQmO=", False
            .Send
            oDoc.body.innerHTML = StrConv(.responsebody, vbUnicode)
            Set r = oDoc.All.tags("table")(0).Rows
            For i = 0 To r.Length - 1
                k = k + 1
                For x = 1 To 16
                    arr(k, x) = r(i).Cells(x - 1).innerText
                Next
            Next
            Set r = Nothing
        Next
    End With
    Range("A2").Resize(k, 6) = arr
End Sub


是这样吗，可是这样还是跑不出来啊

sjvkik

hehex 发表于 2018-6-20 10:05
东方财富网，以前抓过。
你抓的网页是个假的，只是一个展示窗体，永远显示第一页，真实是用下面的页面的数 ...

Sub cc()
    Dim arr(1 To 100000, 1 To 16)
    Cells.ClearContents
    Set oDoc = CreateObject("htmlfile")
    [a1:d1] = Array("序号", "股票代码", "股票简称", "销售毛利率" & Chr(10) & "%")
    With CreateObject("MSXML2.XMLHTTP")
        For j = 1 To 73
            .Open "GET", "http://dcfm.eastmoney.com/em_mutisvcexpandinterface/api/js/get?type=YJBB20_YJBB&token=70f12f2f4f091e459a279469fe49eca5&st=latestnoticedate&sr=-1&p=j&ps=50&js=var%20CMCIRQmO=", False
            .Send
            oDoc.body.innerHTML = StrConv(.responsebody, vbUnicode)
            Set r = oDoc.All.tags("table")(0).Rows
            For i = 0 To r.Length - 1
                k = k + 1
                For x = 1 To 16
                    arr(k, x) = r(i).Cells(x - 1).innerText
                Next
            Next
            Set r = Nothing
        Next
    End With
    Range("A2").Resize(k, 6) = arr
End Sub



是这样/？还是过不去呢

Kaohsing

sjvkik 发表于 2018-6-20 14:39
Sub cc()
    Dim arr(1 To 100000, 1 To 16)
    Cells.ClearContents

你的是分析含有table标签的。而该网页是返回json格式数据，所以不能套用

sjvkik

Kaohsing 发表于 2018-6-20 15:33
你的是分析含有table标签的。而该网页是返回json格式数据，所以不能套用

那怎么弄啊

Kaohsing

sjvkik 发表于 2018-6-20 17:21
那怎么弄啊

参考http://club.excelhome.net/thread-1376856-1-1.html