东方财富网天天练

onlycxb

73楼问题来源，http://club.excelhome.net/thread-1197941-1-1.html，代码中仅为参照示例，请斧正！见不到73楼代码说明正在审核中

学不完用不尽

一表网尽东方财富。

ym123

onlycxb 发表于 2015-4-4 08:07
第一季度业绩预告，请测试，

您好老师！请教如何获取年终分配预告表格里的代码：[url=http://data.eastmoney.com/bbsj/201412/yjyg/3.html]http://data.eastmoney.com/bbsj/201412/yjyg/3.html[/url]    谢谢！

ym123

同上重复删除

ym123

同上重复删除

hwwyb

麻烦问下，http://data.eastmoney.com/bbsj/201412/szbl.html，这个网页怎么取，用原来的代码取不了，麻烦onlycxb帮忙看看
Sub t()
    Dim html, db, i%, j%, k%, rowx, TD, TR, arrdata(1 To 100000, 1 To 18), P
   
    For P = 1 To 3
    Set html = CreateObject("htmlfile")
    With CreateObject("msxml2.xmlhttp")
        .Open "GET", "http://data.eastmoney.com/bbsj/201412/szbl/szbl/" & P & ".html", False '以取第1页数据为例
        .send
        html.body.innerhtml = .responsetext
    End With

    Set db = html.all.tags("table")
    For i = 0 To db.Length - 1
        If db(i).classname = "tab1" Then
            Set rowx = db(i).Rows
            For Each TR In rowx
                j = j + 1
                k = 0
                For Each TD In TR.Cells
                     k = k + 1
                If j > 1 Then arrdata(j, k) = TD.innertext
                Next TD
            Next TR
        End If
    Next i
    Set html = Nothing
    Set db = Nothing
    Set rowx = Nothing
    Next P
    Cells.Clear
    [a1].Resize(j, 18) = arrdata
    For i = 3 To Sheet5.[a65535].End(xlUp).Row
   
   
    If Sheet5.Cells(i, 1) = "序号" Then Sheet5.Rows(i).Delete
         
    Next

   
    i = Sheet5.[a65535].End(xlUp).Row
    Worksheets("Sheet5").Range("A2:M" & i).Copy _
    Destination:=Worksheets("Sheet1").Range("A3")

End Sub

hwwyb

根据楼主的代码，我修改如下，已经可以了，谢谢！

Sub test()
    Dim strJs, P, arr, i
    Cells.ClearContents
    With CreateObject("Microsoft.XMLHTTP")
        .Open "GET", "http://datainterface.eastmoney.com/EM_DataCenter/JS.aspx?type=SR&sty=SZBL&fd=2014-12-31&st=2&sr=-1&p=1&ps=1&js=(pc),(x)", False
        .send
        P = Split(.responsetext, ",")(0)
        .Open "GET", "http://datainterface.eastmoney.com/EM_DataCenter/JS.aspx?type=SR&sty=SZBL&fd=2014-12-31&st=2&sr=-1&p=1&ps=" & P & "&js=var%20a={pages:(pc),data:[(x)]}", False
        .send
        
         
        strJs = .responsetext & ";var b=a.data;var s=''; for(x in b){s+=b[x]+'\r';}"
    End With
    With CreateObject("MSScriptControl.ScriptControl")
        .Language = "javascript"
        strJs = .Eval(strJs)
    End With
    arr = Split(strJs, vbCr)
    With ActiveSheet
        .[a2].Resize(UBound(arr)) = WorksheetFunction.Transpose(arr)
       .[a:a].TextToColumns Destination:=Range("A1"), Comma:=True
    End With
     Cells(1, 1).Resize(1, UBound(arr) + 1) = Array("股票代码", "股票简称", "利润分配 ", "送转比例", "现金分红", "每股收益(元)", "每股未分配利润(元)", "每股未分配利润(元)", "上期每股未分配利润(元)  ", "上期每股资本公积金(元)", "股权登记日", "公告日期")
     i = Sheet5.[a65535].End(xlUp).Row
    Worksheets("Sheet5").Range("A2:M" & i).Copy _
    Destination:=Worksheets("Sheet1").Range("B3")
End Sub

onlycxb

hwwyb 发表于 2015-4-12 20:58
麻烦问下，http://data.eastmoney.com/bbsj/201412/szbl.html，这个网页怎么取，用原来的代码取不了，麻烦o ...

改版了吧。建议还是百度一下教程。不要总是索取代码。

onlycxb

学不完用不尽 发表于 2015-4-12 09:28
一表网尽东方财富。

谢谢，只是练习而已。没有对网站信息做具体研究。

onlycxb

ym123 发表于 2015-4-12 20:47
您好老师！请教如何一次操作同时完成以下两个主题全部分页数据的提取，在一个工作簿内的两个表格内分别显 ...

这只是数据在表格中的分配问题,循环两次，一次写入一个表即可。论坛交流仅提供主要代码，不解释。