请帮忙修改一下自动导入网页部分数据的代码（赠送财富值2000）

itxianfeng · 发表于 2009-6-9 15:39

这个问题是所有论坛会员中的很多急需解决的问题，使用数据导入WEB的方法，数据导入不进来，原因可能是网站不允许导入数据，但是以前有高人利用VBA代码可以导入这些数据（详细看下面的附件中代码），所以帮助了我也就等于帮助了大家，我愿意将自己的2000财富赠送给解决问题的人，不知道版主能否帮一下忙，届时把财富值给转移给解决问题的人。
这个代码是以前的会员编写的，但是我只需要列出原表中的部分数据（删除几列不需要的数据）怎样修改，里面还缺少换手率和量比、振幅三列数据的显示，请帮忙添加换手率和量比和振幅三列数据。再就是刷新数据后，是添加根据涨幅率排序的代码
现在发现原作者的新浪网站数据不全，缺少这三列数据，如果改成和讯或雅虎网的数据之后，数据就齐全了。哪一个网站的数据都无所谓，关键是数据齐全，总共大约1280多个股票，谢谢
http://quote.hexun.com/ 这个和讯网址数据全，并且和我需要的数据格式差不多，进入步骤：行情中心 > 沪深股市 > A股市场 > 全部分类 > 沪深板块，就会找到全部的数据

http://yahoo.compass.cn/stock/newsort.php?market=sz&type=A 沪市A股网址
http://yahoo.compass.cn/stock/newsort.php?market=sh&type=A 深市A股网址

下面的附件是我所需要的数据，上面的附件是原作者的，请按下按钮执行刷新操作

[ 本帖最后由 itxianfeng 于 2009-6-13 15:05 编辑 ]

itxianfeng · 发表于 2009-6-9 18:42

自己试着修改一下，引用的数据还是对不上号，请帮忙看看
Sheets(1).Cells(idx + 3, 2) = tmp(0) '股票名称
            If tmp(3) = 0 Then
                  Sheets(1).Cells(idx + 3, 3) = "-"
                  Sheets(1).Cells(idx + 3, 4) = "-" '最新价
                  Sheets(1).Cells(idx + 3, 5) = "-" '(最新价-昨收)/昨收
                  Sheets(1).Cells(idx + 3, 6) = "-" '最新价-昨收
                  Sheets(1).Cells(idx + 3, 7) = "-" '最高
                  Sheets(1).Cells(idx + 3, 8) = "-" '最低价
                  Sheets(1).Cells(idx + 3, 9) = "-" '
                  Sheets(1).Cells(idx + 3, 10) = "-"  '

            Else
                  Sheets(1).Cells(idx + 3, 5) = tmp(3)    '最新价
                  Sheets(1).Cells(idx + 3, 4) = (tmp(3) - tmp(2)) / tmp(2) '(最新价-昨收)/昨收=涨跌幅
                  Sheets(1).Cells(idx + 3, 6) = tmp(3) - tmp(2) '最新价-昨收=涨跌额
                  Sheets(1).Cells(idx + 3, 7) = tmp(4)    '最高价
                  Sheets(1).Cells(idx + 3, 8) = tmp(5)    '最低价
                  Sheets(1).Cells(idx + 3, 9) = tmp(15) '换手率
                  Sheets(1).Cells(idx + 3, 10) = tmp(24) '量比

            End If

            Sheets(1).Cells(idx + 3, 14) = tmp(31)  '时间

      Case 18:
            Sheets(1).Cells(idx + 3, 2) = tmp(1) '股票名称
            Sheets(1).Cells(idx + 3, 4) = (tmp(6) - tmp(2)) / tmp(2) '(最新价-昨收)/昨收
            Sheets(1).Cells(idx + 3, 5) = tmp(6) '最新价
            Sheets(1).Cells(idx + 3, 6) = tmp(6) - tmp(2) '最新价-昨收=涨跌额
            Sheets(1).Cells(idx + 3, 7) = tmp(4) '最高价
            Sheets(1).Cells(idx + 3, 8) = tmp(5) '最低价
            Sheets(1).Cells(idx + 3, 9) = tmp(15) '换手率
            Sheets(1).Cells(idx + 3, 10) = tmp(24)  '量比


            Sheets(1).Cells(idx + 3, 14) = tmp(18)  '时间

itxianfeng · 发表于 2009-6-10 06:08

找到原因了，今天进到新浪网才发现里面没有换手率量比这两个数据
雅虎有数据很全，但是我改的代码不起作用，现在提供一下地址
http://yahoo.compass.cn/stock/newsort.php?market=sz&type=A 沪市A股
http://yahoo.compass.cn/stock/newsort.php?market=sh&type=A 深市A股

itxianfeng · 发表于 2009-6-11 06:00

请能者多劳，将此问题解决，这是很多人需要解决的。

TY1011 · 发表于 2009-6-12 10:11

楼主的帖子中的问题解决没有，如解决，请分享，没有帮你顶起

itxianfeng · 发表于 2009-6-12 22:04

原帖由 TY1011 于 2009-6-12 10:11 发表
楼主的帖子中的问题解决没有，如解决，请分享，没有帮你顶起

多谢楼上的关心，目前我只能采用笨办法，全选-复制-粘贴但这只是适合当前的屏幕，对以后的屏幕需要挨张的操作，太费劲了。

ldy · 发表于 2009-6-12 23:12

这个网页并不是一次返回所有数据，也是要翻页的，只不过它把翻页功能做到滚动条里去了。
并且没有页面显示，要从这个页面得到数据，要花很长的时间分析，还不一定有结果。
找一个类似百度这样的就好办多了，有现成的代码。

http://baidu.hexun.com/stock/sor ... er=-10&PageNo=1

itxianfeng · 发表于 2009-6-13 13:59

谢谢版主的回复和提供的网址，我的分析要求速度快，就是早上9：30以后，每隔10分钟对当前发生的数据即时用VBA自动分析解决，网上的数据很多是没用的，所以要排除杂乱的信息，留下我需要的重要数据。
其实除了股票代码和股票名称两个必要的条件外，我只需统计涨幅量比换手率振幅这四个数据，其他数据不需要，可以忽略（因为其他因素用K线图和趋势指标就行了）。
我想把需要的数据拷贝到EXCEL中，然后再排序分析。
和讯网站提供的数据基本上与我要求的数据相同，但是就是拷贝不下来，只能一屏一屏的拷贝，速度太慢了，而且拷贝下来还要去掉链接改，股票代码拷贝的也不规范（000022会变成22），
我在 1楼帖子中的下面的那个附件中，利用VBA可以根据用户的需求代码直接的调用出所有的数据，（注意按下那个按钮以后才会自动的刷新数据）但是缺少量比和换手率和振幅三个重要的项目，我观察了几天VBA代码试着修改，但是终归因为自己的水平有限，不会修改代码只好求救本网站的高手了。

[ 本帖最后由 itxianfeng 于 2009-6-13 14:33 编辑 ]

itxianfeng · 发表于 2009-6-13 14:29

昨天刚刚发现，和讯网站还有一个重要的功能，直接点击数据的标题名称，就会按照标题名称直接自动排序，别的网址都没有这个很重要的功能。
这个自动排序的操作与我所需要的统计分析方法已经很接近了。
http://quote.hexun.com/

[ 本帖最后由 itxianfeng 于 2009-6-13 14:53 编辑 ]

winland · 发表于 2009-6-13 15:01

如果需要速度的话，我建议使用Sohu的股票数据，Sohu返回的数据只是一小段包含股票实时信息的JSON代码，因此数独还是非常快的。下面是我自己用的一个每天下载股票数据用的代码，根据你的代码列表（从第一列的第2行开始，以"cn_000002"这样的格式）。你可以根据你自己的需要修改一下。
For j = 2 To 1445
      strCode = Sheet7.Cells(j, 1)
      strQuery = "http://hq.stock.sohu.com/cn/" & Right(strCode, 3) & "/" & strCode & "-2.html"
      Set httpreq = New XMLHTTP30
      httpreq.Open "GET", strQuery, False
      httpreq.setRequestHeader "Content-Type", "text/html"
      httpreq.send

      If httpreq.Status = 200 Then
         txtContent = httpreq.responseText

         arrT = Split(txtContent, "PEAK_ODIA")
         For i = 0 To UBound(arrT)
            If InStr(1, arrT(i), "time'") > 0 Then
                  arrT1 = Split(arrT(i), "','")
                  If arrT1(1) = Format(Month(dDate), "00") And arrT1(2) = Format(Day(dDate), "00") Then
                     arrT1 = Split(arrT(3), "','")
                     If arrT1(5) <> 0 Then
                        Sheet2.Cells(j, iColumn + 1) = arrT1(8)    '换手率
                        Sheet3.Cells(j, iColumn + 1) = arrT1(7)    '成交额
                        Sheet4.Cells(j, iColumn + 1) = arrT1(5)    '成交量
                        Sheet5.Cells(j, iColumn + 1) = arrT1(3)    '涨跌
                        Sheet6.Cells(j, iColumn + 1) = arrT1(2)    '当前值
                        Sheet7.Cells(j, iColumn + 1) = arrT1(14)    '开盘
                        Sheet12.Cells(j, iColumn + 1) = arrT1(11) '最低
                        Sheet13.Cells(j, iColumn + 1) = arrT1(10) '最高
                     End If
                  End If
                  Exit For
            End If
         Next i
      Else
         reportErr httpreq.Status
      End If
Next j

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

[求助] 请帮忙修改一下自动导入网页部分数据的代码（赠送财富值2000）