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

itxianfeng

这个问题是所有论坛会员中的很多急需解决的问题，使用数据导入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

自己试着修改一下，引用的数据还是对不上号，请帮忙看看
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

找到原因了，今天进到新浪网才发现里面没有换手率 量比这两个数据
雅虎有数据很全，但是我改的代码不起作用，现在提供一下地址
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

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

TY1011

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

itxianfeng

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

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

ldy

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


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

itxianfeng

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

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

itxianfeng

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

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

winland

如果需要速度的话，我建议使用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