[文件操作] 【已解决】批处理把网页表格数据 下载到本地excel文件 新

uuu888s

现在要把这个网页http://data.eastmoney.com/soft/zlsj/xt.html  的表格数据下载到本地的excel xls文件里
并把最后一列 持仓明细 改成该股的总持股市值(亿元)  持股市值(亿元)的数据 可点击持仓明细链接 在该页面里有持股市值(亿元)这一列 要把该列数据求和 得到总的持股市值(亿元)

该表格数据链接http://data.eastmoney.com/aspx/data.aspx?name=RptOrganizationPositions&orgType=Intrust&reportDate=20141231&page=1&pageSize=550&sortType=2&sortRule=-1&jsname=DoSLVGvD&changeType=All%20

如600179持股市值 数据如下
http://data.eastmoney.com/aspx/data.aspx?name=jgcgdetail&orgType=Xintuo&reportDate=20141231&page=1&pageSize=50&sortType=2&sortRule=-1&jsname=pDPZhTqy&codes=60017901%20
不同的股票只要改codes  codes=股票代码+01或02  01还是02 可根据表格数据 最后一个数值 如"600179,黑化股份,7,2308.17,5.92,530.13,29.82,01"

CrLf

回复 7# apang


其实原网页中有现成代码，反正我就是抄过来的...

uuu888s

回复 7# apang


   等15分钟 真得有耐心啊  改成500 不知道服务器让不让

apang

回复 6# uuu888s


    是有这个问题，在17、18行之间插入一行：

WScript.Sleep 1000
复制代码

800条数据，每条数据延时1秒，那速度。。。相信你会有耐心

uuu888s

回复 5# apang


   
还有个问题 现在取的数据是2014-12-30 数据在100行以内 但是我现在要取2014-09-30 的数据 有800多条 运行结果是最后一列的数据只取到1/3左右 服务器就连接不上了 出现403拒绝访问  ( 可能频繁连接次数太多?? 禁止你的ip连接5分钟左右 ) 是否加个延时器什么的

apang

回复 4# uuu888s


    已修改

uuu888s

回复 3# apang

Apang
我想在xls文件里再加一列(持仓市值变动值)   该列的值为  持仓总市值*持股变动数值/持股总数  也就是你的表里的H(列)*F(列)/D(列) 谢谢了

apang

test.vbs

url = "http://data.eastmoney.com/aspx/data.aspx?name=RptOrganizationPositions&orgType=Intrust&reportDate=20141231&page=1&pageSize=550&sortType=2&sortRule=-1&jsname=DoSLVGvD&changeType=All%20"
s = "股票代码,股票简称,持有信托家数,持股总数,占总股本比例,持股变动数值,持股变动比例,持仓明细,持仓市值变动值"

txt = getText(url)
txt = Replace(txt, """,""", vbLf)
arr = Split(Split(txt, """")(1), vbLf)

For i = 0 to UBound(arr)
        a = Split(arr(i), ",")
        url = "http://data.eastmoney.com/aspx/data.aspx?name=jgcgdetail&orgType=Xintuo&reportDate=20141231&page=1&pageSize=50&sortType=2&sortRule=-1&jsname=pDPZhTqy&codes=" & a(0) & a(7) & "%20"
        a(7) = RegEx(getText(url))
        ReDim Preserve a(8)
        If a(5) <> "-" and a(7) <> "-" and a(3) <> "-" Then
                a(8) = FormatNumber(a(5) * a(7) / a(3), 2, true)
        Else a(8) = "-"
        End If
        arr(i) = Join(a, ",")
Next

s = s & vbCrLf & Join(arr, vbCrLf)

Set fso = CreateObject("Scripting.FileSystemObject")
''fso.OpenTextFile("1.csv", 2, true).Write s
fso.OpenTextFile("1.xls", 2, true).Write Replace(s, ",", vbTab)

MsgBox "OK"

Function getText(ByVal url)
        Set http = CreateObject ("Microsoft.XMLHTTP")
        http.Open "GET", url, false
        http.Send
        getText = http.responseText
End Function

Function RegEx(txt)
        Set re = New RegExp
        re.Pattern = ",信托,[^,]*,([\d\.]+),"
        re.Global = true
        If Not re.Test(txt) Then RegEx = "-" : Exit Function
        For Each m in re.Execute(txt)
                n = n + 0 + m.SubMatches(0)
        Next
        RegEx = n
End Function
复制代码

uuu888s

这里有个类似思路的代码 供参考呀