东方财富 龙虎榜数据 地址列表读取数据

mmm426

YZC51 发表于 2015-10-29 07:37
请测试17楼代码！！！

开始在win10 office2016版里出现附件的错误 错误代码还会变
转到win7 2010的电脑上后 开始也跳出 400的错误，或内存溢出， 还不显示 错误原因
...
问下15楼和17楼 2个的区别
15楼是从真实的数据地址，17楼就能从给的地址读取了
这2种在速度上差别大么

mmm426

15楼的在win10能运行
速度也快很多

code=部分改了就可以把

kings12333

mmm426 发表于 2015-10-29 08:40
15楼的在win10能运行
速度也快很多

哥们，你都WIN10啦，我还用XP呢，代码我在EX2003无任何问题，关于地址一个是后台，一个是前台吧，前台广告多……呵……

YZC51

请在代码最后插入以下代码

1.    Cells.Hyperlinks.Delete

复制代码

YZC51

mmm426 发表于 2015-10-29 08:40
15楼的在win10能运行
速度也快很多

修改后应该可以的！
应用如何请给与评价！
谢谢

mmm426

YZC51 发表于 2015-10-29 09:06
修改后应该可以的！
应用如何请给与评价！
谢谢

根据15楼的  外套个循环
缺少对象TT
Format(Now, "00") 部分怎么加上去
帮看下的

Sub YZC()
    Dim objXML As Object
    Dim i, j, r
    Application.ScreenUpdating = False
    Range("e3:n3000").ClearContents '删除内容
    'URL = "http://quote.tool.hexun.com/hqzx/quote.aspx?type=2&market=0&sorttype=3&updown=up&page=1&count=28" & Format(Now, "00")
   
    For i = 2 To 100
        j = xlapp.Cells(i, 4).Value
   
    URL = "http://datainterface.eastmoney.com/EM_DataCenter/JS.aspx?type=LHB"
    URL = URL & "&sty=YYHSIU"
    URL = URL & "&code="
    URL = URL & j
    URL = URL & "&p=2"
    URL = URL & "&ps=" & 50
    URL = URL & "&js=var%20ZlHguMuK=1"

   
   
    Set objXML = CreateObject("Microsoft.XMLHTTP")
    With objXML
        .Open "GET", URL, False
        .send
        str1 = .responsetext
     End With
        Str2 = Split(Split(str1, "([""")(1), """])")(0)
        Str2 = Replace(Replace(Str2, """,""", Chr(10)), ",", Chr(9))
    With CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
        .SetText Str2
        .PutInClipboard
    End With

    Range("E(50*(i-2)+2)").Select
    ActiveSheet.Paste 'False '无条件覆盖
    Set objXML = Nothing
    [C1] = Right(Left(URL, 90), 8) '
    Application.ScreenUpdating = True
    Next
   
   
   
End Sub

YZC51

kings12333 发表于 2015-10-29 07:52
可行，非常感谢，但下载后的数据里带有远程链接，能不能将它去掉，一点就自动打开网页了

请参考24楼的代码！！！

YZC51

1.地址打不开，无法测试
2.不需要加format
http://datainterface.eastmoney.com/EM_DataCenter/JS.aspx?type=LHB

mmm426

    URL = "http://datainterface.eastmoney.com/EM_DataCenter/JS.aspx?type=LHB&sty=YYHSIU"
    URL = URL & "&code="
    URL = URL & j
    URL = URL & "&p=2"
    URL = URL & "&ps=" & 50
    URL = URL & "&js=var%20ZlHguMuK=1"

mmm426

YZC51 发表于 2015-10-29 09:23
1.地址打不开，无法测试
2.不需要加format
http://datainterface.eastmoney.com/EM_DataCenter/JS.aspx?t ...

    URL = "http://datainterface.eastmoney.com/EM_DataCenter/JS.aspx?type=LHB&sty=YYHSIU"
    URL = URL & "&code="
    URL = URL & j
    URL = URL & "&p=2"
    URL = URL & "&ps=" & 50
    URL = URL & "&js=var%20ZlHguMuK=1"