请老师写个采集股票数据的代码

lixjun · 发表于 2011-3-29 11:35

想把下面两个网址的数据输出到EXCEL，麻烦老师抽空给看看！！最好是只提取某几列的数据，例如：DDX、DDY，并且以：“代码数据”的形式输出到文本文件，多谢了！！
http://www.ddx.name/dde.asp
http://www.chaoniu8.cn/ddesort.aspx?sqlid=ddesort&paras=0

lixjun · 发表于 2011-3-29 20:51

自己顶一下，请老师帮忙！

金和苑 · 发表于 2011-3-29 22:09

这个excellent应该有的

xmyjk · 发表于 2011-3-29 23:33

Sub Test()
Dim i As Long
Dim tmp() As String, arr() As String
[a1:q1] = Split("代码,简称,最新价,涨幅,换手率,BBD,DDX,I0天内红,DDY,DDZ,通吃率,主动率,量比,特大单差,大单差,小单差,流通盘", ",")
With CreateObject("Microsoft.XMLHTTP")
.Open "get", "http://www.chaoniu8.cn/ddesort.aspx?sqlid=ddesort&paras=0", False
.setRequestHeader "Content-Type", "text/html"
.send
tmp() = Split(Split(Split(Replace(Replace(.responsetext, "'", ""), "],[", ""), "cnmyarray = new Array([")(1), "]);</script>")(0), ",")
End With
ReDim arr(UBound(tmp) \ 16, 15)
For i = 0 To UBound(tmp)
arr(i \ 16, i Mod 16) = tmp(i)
Next
[a2].Resize(UBound(arr) + 1, 16) = arr
[a:q].Columns.AutoFit
MsgBox "Ok"
End Sub

复制代码

[ 本帖最后由 xmyjk 于 2011-3-29 23:55 编辑 ]

xmyjk · 发表于 2011-3-29 23:50

Sub Test()
Dim i As Long, rw As Long
Dim tmp() As String, arr() As String
Dim p As Long
[a1:t1] = Split("股票代码,股票名称,最新价,涨跌幅,换手率,量比,DDX,DDY,DDZ,DDX60,DDY60,5日内,10日内,连续,连增,涨速5,特大买,特大卖,小单买,小单卖", ",")
For p = 1 To 41
rw = [a65536].End(xlUp).Row + 1
With CreateObject("Microsoft.XMLHTTP")
.Open "get", "http://www.ddx.name/script/DDEscript.asp?mk=&sortID=7&sortBY=-1&page=" & p & "&randNum=0.7210666082133784", False
.setRequestHeader "Content-Type", "text/html"
.send
tmp() = Split(Split(Split(Replace(Replace(.responsetext, """", ""), "],[", ","), "var pageArray = new Array([")(1), "]);")(0), ",")
End With
ReDim arr(UBound(tmp) \ 20, 19)
For i = 0 To UBound(tmp)
arr(i \ 20, i Mod 20) = tmp(i)
Next
Cells(rw, 1).Resize(UBound(arr) + 1, 20) = arr
Next
[a:t].Columns.AutoFit
MsgBox "Ok"
End Sub

复制代码

[ 本帖最后由 xmyjk 于 2011-3-29 23:52 编辑 ]

xmyjk · 发表于 2011-3-29 23:56

超牛网的附件重新更新了

这个网站有刷新控制的，一个IP在一定时间有刷新频率控制，如果失败，过会儿在刷看看

lixjun · 发表于 2011-3-30 00:57

多谢上旋下弦月老师！太感谢了！！

我从本论坛下载了个很早前的附件，照猫画虎改成了超牛网的。只是每页第一行不显示，研究了半天也不知问题出在哪里。采集速度比您的慢许多，只是想学习一下，麻烦老师给看看。另外，能否增加数据更新时间和文本输出功能。输出文本主要是方便导入到股票自定义数据，格式如下。超牛网的代码最好能增加SH、SZ。多谢了！！

超牛网downloadDDE-2.rar (188.17 KB, 下载次数: 245)

文本格式.rar (15.29 KB, 下载次数: 153)

xmyjk · 发表于 2011-3-30 01:27

Sub Test()
Dim i As Long, rw As Long
Dim tmp() As String, arr() As String
Dim p As Long
[a1:t1] = Split("股票代码,股票名称,最新价,涨跌幅,换手率,量比,DDX,DDY,DDZ,DDX60,DDY60,5日内,10日内,连续,连增,涨速5,特大买,特大卖,小单买,小单卖", ",")
On Error Resume Next
For p = 1 To 41
rw = [a65536].End(xlUp).Row + 1
With CreateObject("Microsoft.XMLHTTP")
.Open "get", "http://www.ddx.name/script/DDEscript.asp?mk=&sortID=7&sortBY=-1&page=" & p & "&randNum=0.7210666082133784", False
.setRequestHeader "Content-Type", "text/html"
.send
tmp() = Split(Split(Split(Replace(Replace(.responsetext, """", ""), "],[", ","), "var pageArray = new Array([")(1), "]);")(0), ",")
End With
ReDim arr(UBound(tmp) \ 20, 19)
For i = 0 To UBound(tmp)
arr(i \ 20, i Mod 20) = tmp(i)
Next
Cells(rw, 1).Resize(UBound(arr) + 1, 20) = arr
Next
[a:t].Columns.AutoFit
Dim nm As Long
Dim j As Long, k As Long
Dim gp() As String, tmp1() As String
Dim m As Long
With CreateObject("Microsoft.XMLHTTP")
.Open "get", "http://www.ddx.name/js/stockCode.js", False
.setRequestHeader "Content-Type", "text/html"
.send
tmp1() = Split(Split(Split(Replace(Replace(StrConv(.responsebody, vbUnicode, &H804), """", ""), "],[", ","), "var stockCodeArray=new Array([")(1), "]);")(0), ",")
End With
ReDim gp(UBound(tmp1) \ 2, 1)
For m = 0 To UBound(tmp1)
gp(m \ 2, m Mod 2) = tmp1(m)
Next
nm = [a65536].End(xlUp).Row - 1
For j = 1 To nm
For k = 1 To UBound(gp) + 1
If Trim(Cells(j + 1, 1).Value) = gp(k - 1, 0) Then Cells(j + 1, 2).Value = gp(k - 1, 1): Exit For
Next
Next
MsgBox "Ok"
End Sub

复制代码

xmyjk · 发表于 2011-3-30 01:30

原帖由 lixjun 于 2011-3-30 00:57 发表
多谢上旋下弦月老师！太感谢了！！
我从本论坛下载了个很早前的附件，照猫画虎改成了超牛网的。只是每页第一行不显示，研究了半天也不知问题出在哪里。采集速度比您的慢许多，只是想学习一下，麻烦老师给 ...

行啊，明天帮你看，困了，先休息。

lixjun · 发表于 2011-3-30 09:23

多谢老师深夜还来帮忙，辛苦了！DDX在线的两个脚本都试了试，第一个有很多重复股票，还有不少股票没能显示。第二个脚本好像执行一会就没反应了。DDX在线估计做了限制，在网页里只能点击前7个页面。不好做的话，可以试试下面的网站，不限制页面，速度还行。谢谢老师了！！

http://www.shdjt.com/ （散户大家庭）
http://www.shdjt.com/sort.asp （这个是排序的页面）

		自动登录	找回密码
密码			免费注册

[求助] 请老师写个采集股票数据的代码

超牛网的做好了，代码如下，EXCEL如附件

DDX的也做好了，没有股票名称明天再调试

回复 6楼 xmyjk 的帖子

DDX把股票名称的修正好了，代码如下，excel如附件