ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
300集Office 2010微视频教程 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
楼主: mmm426

[已解决] 东方财富 龙虎榜数据 地址列表读取数据

[复制链接]

TA的精华主题

TA的得分主题

 楼主| 发表于 2015-10-29 08:33 | 显示全部楼层
YZC51 发表于 2015-10-29 07:37
请测试17楼代码!!!

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

TA的精华主题

TA的得分主题

 楼主| 发表于 2015-10-29 08:40 | 显示全部楼层
15楼的在win10能运行
速度也快很多

code=部分改了就可以把

TA的精华主题

TA的得分主题

发表于 2015-10-29 08:47 | 显示全部楼层
mmm426 发表于 2015-10-29 08:40
15楼的在win10能运行
速度也快很多

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

TA的精华主题

TA的得分主题

发表于 2015-10-29 09:02 | 显示全部楼层
请在代码最后插入以下代码
  1.    Cells.Hyperlinks.Delete
复制代码

TA的精华主题

TA的得分主题

发表于 2015-10-29 09:06 | 显示全部楼层
mmm426 发表于 2015-10-29 08:40
15楼的在win10能运行
速度也快很多

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

TA的精华主题

TA的得分主题

 楼主| 发表于 2015-10-29 09:12 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
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

TA的精华主题

TA的得分主题

发表于 2015-10-29 09:13 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
kings12333 发表于 2015-10-29 07:52
可行,非常感谢,但下载后的数据里带有远程链接,能不能将它去掉,一点就自动打开网页了

请参考24楼的代码!!!

TA的精华主题

TA的得分主题

发表于 2015-10-29 09:23 | 显示全部楼层

TA的精华主题

TA的得分主题

 楼主| 发表于 2015-10-29 09:37 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
    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"

TA的精华主题

TA的得分主题

 楼主| 发表于 2015-10-29 09:37 | 显示全部楼层
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"
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-3-28 19:46 , Processed in 0.048417 second(s), 7 queries , Gzip On, Redis On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表