阿菜求大神帮写个提取东财网页上的几个项目的代码

咆哮的风雷云

http://data.eastmoney.com/zjlx/list.html
只要：股票代码，名称，所属行业，这三项，因更新需要我用笨法翻页粘贴做这事要花二到三小时，实在太辛苦了，在此叩首，谢过了。

咆哮的风雷云

VBA的书，已买了几本，实在是看不懂，也记不住，可能是岁数不饶人吧。

liucqa

论坛搜 东方财富网

duquancai

Sub 抓取网页数据()
    Dim xmlhttp As Object, arr(1 To 10000, 1 To 3), D As Object, W As Object
    Set D = CreateObject("Htmlfile"): Set W = D.parentWindow
    Set xmlhttp = CreateObject("msxml2.xmlhttp")
    Cells.Clear: [a1:c1] = [{"股票代码","名称","所属行业"}]
    For j = 1 To 2 '抓取页码，本例抓2页试试！
        xmlhttp.Open "GET", "http://nufm.dfcfw.com/EM_Finance2014NumericApplication/JS.aspx/JS.aspx?type=ct&st=(FFRank)&sr=1&p=" & j & "&ps=50&js=var%20fLXgtErK={pages:(pc),data:[(x)]}&token=894050c76af8597a853f5b408b759f5d&cmd=C._AB&sty=DCFFITAM&rt=49886027", False
        xmlhttp.send
        Do While xmlhttp.readyState <> 4
            DoEvents
        Loop
        W.execScript xmlhttp.responseText & ";a=fLXgtErK.data;l=a.length"
        For i = 0 To W.l - 1
            n = n + 1
            arr(n, 1) = "'" & Split(W.eval("a[" & i & "]"), ",")(1)
            arr(n, 2) = Split(W.eval("a[" & i & "]"), ",")(2)
            arr(n, 3) = Split(W.eval("a[" & i & "]"), ",")(13)
        Next
    Next
    Range("a2").Resize(n, 3) = arr
End Sub

duquancai

咆哮的风雷云 发表于 2017-6-4 14:29
VBA的书，已买了几本，实在是看不懂，也记不住，可能是岁数不饶人吧。

附件，打开，按钮》》》》》》》》》》》》》》》》》》》》》

咆哮的风雷云

duquancai 发表于 2017-6-4 21:32
Sub 抓取网页数据()
    Dim xmlhttp As Object, arr(1 To 10000, 1 To 3), D As Object, W As Object
   ...

您实在太利害了，小可仰视您的神力，我实在是太菜了，无三一反三的能力，希望您能继续下，全部一个不留地抓起来。谢谢了！

duquancai

咆哮的风雷云 发表于 2017-6-4 23:03
您实在太利害了，小可仰视您的神力，我实在是太菜了，无三一反三的能力，希望您能继续下，全部一个不留地 ...

一个不剩的抓下来》》》》》》》》》》》》》》》》》》》》》》

咆哮的风雷云

liucqa 发表于 2017-6-4 20:29
论坛搜 东方财富网

谢谢您帮提了个线索，等会试试。我曾上午搜到一个有17页，能显的有用无用我全保存了下来，里面没我现在需要的，所以才发这贴求助。

咆哮的风雷云

duquancai 发表于 2017-6-4 21:52
附件，打开，按钮》》》》》》》》》》》》》》》》》》》》》

谢谢，反映过来把2改70，成功了，太感谢您了！您的教育方法太棒了。

咆哮的风雷云

我都忘了这个发帖，谢谢也没