东方财富网天天练

onlycxb

补9：

数据采集网址是http://quote.eastmoney.com/center/list.html#33，实现代码所对应的涨跌幅数值
行情中心首页 > 沪深股市 > 沪深A股

1. 
   
2. 'GET http://hqdigi2.eastmoney.com/EM_Quote2010NumericApplication/index.aspx?type=s&sortType=C&sortRule=-1&pageSize=20&page=1&jsName=quote_123&style=33&token=44c9d251add88e27b65ed86506f6e5da&_g=0.4773907992057502
   
3. Sub test()
   
4.     Dim strJs, P, arr
   
5.     Cells.ClearContents
   
6.     With CreateObject("Microsoft.XMLHTTP")
   
7.         .Open "GET", "http://hqdigi2.eastmoney.com/EM_Quote2010NumericApplication/index.aspx?type=s&sortType=C&sortRule=-1&pageSize=1&page=1&jsName=a&style=33&token=44c9d251add88e27b65ed86506f6e5da&_g=" & Rnd, False
   
8.         .send
   
9.         P = Split(Split(.responsetext, "pages:")(1), "}")(0)
   
10.         .Open "GET", "http://hqdigi2.eastmoney.com/EM_Quote2010NumericApplication/index.aspx?type=s&sortType=C&sortRule=-1&pageSize=" & P & "&page=1&jsName=a&style=33&token=44c9d251add88e27b65ed86506f6e5da&_g=" & Rnd, False
    
11.         .send
    
12.         strJs = .responsetext & ";var b=a.rank;var s=''; for(x in b){ y=b[x].split(',');s+=y.slice(1,3)+'\t'+ y.slice(11,12)+'\r'} "
    
13.     End With
    
14.     With CreateObject("MSScriptControl.ScriptControl")
    
15.         .Language = "javascript"
    
16.         strJs = .eval(strJs)
    
17.         Debug.Print strJs
    
18.     End With
    
19.     Debug.Print strJs
    
20.     arr = Split(strJs, vbCr)
    
21. 
    
22.     With ActiveSheet
    
23.         .[a2].Resize(UBound(arr)) = WorksheetFunction.Transpose(arr)
    
24.         .[a:a].TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, ConsecutiveDelimiter:=False, Tab:=True, Comma:=True, FieldInfo:=Array(Array(1, 2), Array(2, 2), Array(3, 1))
    
25.     End With
    
26. End Sub
    

复制代码

onlycxb

test9.rar (92.38 KB, 下载次数: 438)

2015-3-29 21:54 上传

点击文件名下载附件

hwwyb

市场代码        查询代码        股票代码        股票简称        最近股东大会：       
0           sz002337        002337        赛象科技               
1           sh601012        601012        隆基股份               
0           sz300055        300055        万邦达
提取查询代码后，逐一打开个股公司大事网页，提取其中一项最近股东大会的信息
根据学习楼主的代码，写了以下代码，发现以下问题：

1、弹出对话框，询问是否允许存网站COOKIE
2、只能打开第一个查询代码的网页

请楼主，有空帮看看，非常感谢！

Sub t()
    Dim html, db, i%, j%, k%, ii%, tr, td, arr(1 To 100000, 1 To 10)
    URL = "http://f10.eastmoney.com/f10_v2/CompanyBigNews.aspx?code="
    Set html = CreateObject("htmlfile")
    For ii = 2 To 4
    Url1 = Sheet2.Cells(ii, 2)
    With CreateObject("msxml2.xmlhttp")
        .Open "GET", URL & Url1, False
        .send
        html.write .responsetext
    End With
    Set db = html.all.tags("table")
    For i = 0 To db.Length - 1
        If db(i).classname = "listTable" Then
            For Each tr In db(i).Rows
                j = j + 1
                k = 0
                For Each td In tr.Cells
                    k = k + 1
                    arr(j, k) = td.innertext
                Next td
            Next tr
        End If
    Next i
    [a1].Resize(6, 2) = arr
    For i = 1 To 6
        If Cells(i, 1) = "最近股东大会：" Then
         Sheet2.Cells(ii, 5) = Sheet1.Cells(i, 2)
        End If
    Next i
   
   Next
End Sub               

onlycxb

hwwyb 发表于 2015-3-29 22:37
市场代码        查询代码        股票代码        股票简称        最近股东大会：       
0           sz002337        002337        赛象科技               
1           sh601012         ...

26楼代码已经实现全部数据的查询，你仔细看看。

hwwyb

是的，测试了，已经取到股东大会的信息了，谢谢，能否帮看一下33楼的代码的问题，学习提高

luyina

onlycxb 发表于 2015-3-10 13:35
7.东方财富网 > 数据中心 > 年报季报 > 业绩报表

不能用了，请大师给个新代码！先谢谢啦！
数据源地址：http://data.eastmoney.com/bbsj/201412/yjbb.html

onlycxb

luyina 发表于 2015-4-3 10:41
不能用了，请大师给个新代码！先谢谢啦！
数据源地址：http://data.eastmoney.com/bbsj/201412/yjbb.htm ...

东方财富网 > 数据中心 > 年报季报 > 业绩报表

1. Sub test()
   
2.     Dim strJs, P
   
3.     Cells.ClearContents
   
4.     With CreateObject("Microsoft.XMLHTTP")
   
5.         .Open "GET", "http://datainterface.eastmoney.com/EM_DataCenter/JS.aspx?type=SR&sty=YJBB&fd=2014-12-31&st=13&sr=-1&p=1&ps=1&js=(pc),(x)&stat=0&rt=47601296", False
   
6.         .send
   
7.         P = Split(.responsetext, ",")(0)
   
8.         .Open "GET", "http://datainterface.eastmoney.com/EM_DataCenter/JS.aspx?type=SR&sty=YJBB&fd=2014-12-31&st=13&sr=-1&p=1&ps=" & P & "&js=var%20a={pages:(pc),data:[(x)]}&stat=0&rt=47601296", False
   
9.         .send
   
10.         
    
11.          CopyToClipbox .responsetext
    
12.         strJs = .responsetext & ";var b=a.data;var s=''; for(x in b){s+=b[x]+'\r';}"
    
13.     End With
    
14.     With CreateObject("MSScriptControl.ScriptControl")
    
15.         .Language = "javascript"
    
16.         strJs = .Eval(strJs)
    
17.     End With
    
18.     Arr = Split(strJs, vbCr)
    
19.     With ActiveSheet
    
20.         .[a2].Resize(UBound(Arr)) = WorksheetFunction.Transpose(Arr)
    
21.        .[a:a].TextToColumns Destination:=Range("A1"), Comma:=True
    
22.     End With
    
23. End Sub
    

复制代码

onlycxb

东方财富网_数据中心_年报季报_业绩报表.rar (312.35 KB, 下载次数: 564)

2015-4-3 14:00 上传

点击文件名下载附件

onlycxb

luyina 发表于 2015-4-3 10:41
不能用了，请大师给个新代码！先谢谢啦！
数据源地址：http://data.eastmoney.com/bbsj/201412/yjbb.htm ...

见上传文档

LangFan123

谢谢楼主，收藏起来慢慢学习。