ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 效率神器,一键搞定繁琐工作
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
让更多数据处理,一键完成 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 14402|回复: 24

[已解决] 如何用web查询把这个网站的行情数据导入excel

  [复制链接]

TA的精华主题

TA的得分主题

发表于 2012-4-13 00:35 | 显示全部楼层 |阅读模式
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
本帖已被收录到知识树中,索引项:网页交互
http://www.baring.cn/quo/showmarket.html?m=cb,非常喜欢这个数据源,但是貌似这个真是链接不在这个网站上,导致web查询只有标题行,请问如何能导入excel,然后再另一个sheet里面自动写库,这样就可以在excel里看完整行情了。还请各位大大打个样,做成后必回报home,造福home上的金融从业人员。

点评

知识树索引内容:2楼,Winsock控件  发表于 2013-9-25 00:09

TA的精华主题

TA的得分主题

发表于 2012-5-14 21:59 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
本帖最后由 xmyjk 于 2012-5-15 11:51 编辑

需要安装WINSOCK,解压缩MSWINSCK.OCX,放置system32里面,然后注册。然后再VBE界面里面,引用里面,浏览,找到MSWINSCK.OCX,然后引用。

这是个服务器推送消息的例子,即HTTP长连接的例子。这类网站比较难得。更新的数据不需再次发包,仅需和服务器保持连接即可。
  1. Option Explicit
  2. Dim WithEvents Winsock1 As Winsock
  3. Dim m&, flag As Boolean, getpage As String

  4. Sub test()    '打开连接
  5.     Set Winsock1 = New Winsock
  6.     [a1].CurrentRegion.Offset(1).ClearContents
  7.     m = 1: flag = False
  8.     Winsock1.RemoteHost = "www.baring.cn"    '服务器
  9.     Winsock1.RemotePort = 80    'WEB服务器端口
  10.     Winsock1.Connect
  11. End Sub

  12. Sub closeconnect()    '关闭连接
  13.     Winsock1.Close
  14. End Sub

  15. Private Sub Winsock1_Connect()
  16.     Dim strCommand As String

  17.     strCommand = "GET /quo/bin/quotation.dll?fields=Price,LastSettle,Open,High,Low,Close,&symbols=CBCRC0,CBCRCH,CBCRCJ,CBCRCK,CBCRCN,CBCRCU,CBCRCZ,CBRRC0,CBRRCF,CBRRCH,CBRRCK,CBRRCN,CBRRCU,CBRRCX,CBSBC0,CBSBCF,CBSBCH,CBSBCK,CBSBCN,CBSBCQ,CBSBCU,CBSBCX,CBSMC0,CBSMCF,CBSMCH,CBSMCK,CBSMCN,CBSMCQ,CBSMCU,CBSMCV,CBSMCZ,CBSOC0,CBSOCF,CBSOCH,CBSOCK,CBSOCN,CBSOCQ,CBSOCU,CBSOCV,CBSOCZ,CBWHC0,CBWHCH,CBWHCK,CBWHCN,CBWHCU,CBWHCZ, HTTP/1.1" + vbCrLf
  18.     strCommand = strCommand + "Host: www.baring.cn" + vbCrLf
  19.     strCommand = strCommand + "User-Agent: Mozilla/5.0 (Windows NT 5.1; rv:12.0) Gecko/20100101 Firefox/12.0" + vbCrLf
  20.     strCommand = strCommand + "Referer: http://www.baring.cn/quo/showmarket.html?m=cb" + vbCrLf
  21.     strCommand = strCommand + vbCrLf
  22.     Winsock1.SendData strCommand
  23. End Sub

  24. Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
  25.     Dim bin() As Byte
  26.     Dim str As String, arr(), tmp, i&, j&
  27.     Winsock1.GetData bin, vbArray + vbByte
  28.     getpage = getpage & byteToUf(bin)
  29.     Erase bin
  30.     If InStr(getpage, "CBSBCF") > 0 And InStr(getpage, "CBRRCU") > 0 Then flag = True
  31.     If InStr(getpage, "CBSBCF") > 0 And InStr(getpage, "CBRRCU") = 0 Then Exit Sub
  32.     If flag = False Then getpage = "": Exit Sub
  33.     'Debug.Print getpage
  34.     If m = 1 Then
  35.         str = Filter(Split(getpage, vbLf), "CBCRCH")(0)
  36.         tmp = Split(Replace(Replace(Replace(Replace(str, "],]", ""), "[", ""), """", ""), "]", ""), ",")
  37.         ReDim arr(UBound(tmp) \ 9, 8)
  38.         For i = 0 To UBound(tmp)
  39.             If i Mod 9 > 2 Then arr(i \ 9, i Mod 9) = tmp(i) / 100 Else arr(i \ 9, i Mod 9) = tmp(i)
  40.         Next
  41.         [a2].Resize(UBound(arr) + 1, UBound(arr, 2) + 1) = arr
  42.         Range([J2], Cells(UBound(arr) + 2, 10)) = "=D2-I2"
  43.         Range([k2], Cells(UBound(arr) + 2, 11)) = "=J2/I2"
  44.         Range([d2], Cells(UBound(arr) + 2, 4)).Interior.ColorIndex = 0
  45.         Erase arr, tmp
  46.         str = ""
  47.     Else
  48.         Dim mc, mcs
  49.         With CreateObject("vbscript.regexp")
  50.             .Global = True
  51.             .Pattern = "\d+,(\d|,|-)+"
  52.             Set mcs = .Execute(getpage)
  53.             If mcs.Count > 0 Then
  54.                 For Each mc In mcs
  55.                     tmp = Split(mc.Value, ",")
  56.                     arr = Range(Cells(tmp(0) + 2, 4), Cells(tmp(0) + 2, 9)).Value
  57.                     arr(1, 2) = arr(1, 1)
  58.                     For j = 1 To UBound(tmp)
  59.                         If Len(tmp(j)) = 0 Then tmp(j) = 0
  60.                         If j <> 2 Then arr(1, j) = arr(1, j) + tmp(j) / 100
  61.                     Next
  62.                     If tmp(1) > 0 Then Cells(tmp(0) + 2, 4).Interior.ColorIndex = 3
  63.                     If tmp(1) < 0 Then Cells(tmp(0) + 2, 4).Interior.ColorIndex = 4
  64.                     Cells(tmp(0) + 2, 4).Resize(1, 6) = arr
  65.                     Erase tmp, arr
  66.                 Next
  67.             End If
  68.         End With
  69.     End If
  70.     m = m + 1
  71.     getpage = ""
  72. End Sub

  73. Private Function byteToUf(byuf8) As String    'gbk的二进制数组转UTF
  74.     On Error GoTo MyErr
  75.     Dim lngStrLen As Long     '需转换的字符串长度
  76.     Dim byUf(1) As Byte    '字符串暂存1
  77.     Dim strDef As String    '字符串暂存2
  78.     Dim i As Long    '哨兵计数
  79.     Dim strUf As String    '存放结果字符串

  80.     lngStrLen = UBound(byuf8)         '获得字符串长度
  81.     i = 0
  82.     Do While i < lngStrLen
  83.         If byuf8(i) < 128 Then                 '非中文..不作处理。
  84.             strUf = strUf & Chr(byuf8(i))
  85.             i = i + 1
  86.         Else                                 '是中文
  87.             byUf(1) = ((byuf8(i) And 15) * 16 + (byuf8(i + 1) And 60) / 4)
  88.             byUf(0) = (byuf8(i + 1) And 3) * 64 + (byuf8(i + 2) And 63)
  89.             strDef = byUf
  90.             strUf = strUf & strDef
  91.             i = i + 3
  92.         End If
  93.     Loop
  94. MyErr:
  95.     byteToUf = strUf
  96. End Function
复制代码

3.rar

16.71 KB, 下载次数: 416

winsock.rar

48.41 KB, 下载次数: 409

评分

2

查看全部评分

TA的精华主题

TA的得分主题

发表于 2012-5-15 00:49 | 显示全部楼层
本帖最后由 liucqa 于 2012-5-15 01:12 编辑
xmyjk 发表于 2012-5-14 21:59
需要安装WINSOCK,解压缩MSWINSCK.OCX,放置system32里面,然后注册。然后再VBE界面里面,引用里面,浏览, ...

留个记号,崇拜中...

捕获.JPG

捕获不到数据是什么原因,软件协议问题吗?还是这种长连接只能使用Winsock协议来获取数据?

TA的精华主题

TA的得分主题

发表于 2012-5-15 01:40 | 显示全部楼层
本帖最后由 liucqa 于 2012-5-15 01:43 编辑

找了点资料,大致明白什么是服务器推送了

对于服务器推送,使用一个“multipart/mixed”类型的变种--multipart/x-mixed-replace。这里,“x-”表示属于实验类型。“replace”表示每一个新数据块都会代替前一个数据块。也就是说,新数据不是附加到旧数据之后,而是替代它。

下面是实际使用的“multipart/x-mixed-replace”类型:
Content-type:multipart/x-mixed-replace;boundary=ThisRandomString
--ThisRandomString
Content-type:text/plain
第一个对象的数据
--ThisRandomString
Content-type:text/plain
第二个(最后一个)对象的数据。
--ThisRandomString--
使用这一技术的关键是,服务器并不是推送整个“multipart/x-mixed-replace”报文,而是每次发送后数据块。
HTTP连接始终保持,因而服务器可以按自己需要的速度和频率推送新数据,两个数据块之间浏览器仅需在当前窗口等候,用户甚至可以到其他窗口做别的事情,当服务器需要发送新数据时,它只是源(ABC输入法没那个字*&^$#)传输管道发送数据块,客户端相应的窗口进行自我更新。

在服务器推送技术中,“multipart/x-mixed-replace”类型的报文由唯一的边界线组成,这些边界线分割每个数据块。每个数据块都有自己的头标,因而能够指定对象相关的内容类型和其他信息。由于“multipart/x-mixed-replace”的特性是每一新数据块取代前一数据对象,因而浏览器中总是显示最新的数据对象。
“multipart/x-mixed-replace”报文没有结尾。也就是说,服务器可以永远保持连接,并发送所需的数据。如果用户不再在浏览器窗口中显示数据流,或者浏览器到服务器间的连接中间(例如用户按“STOP”按钮),服务器的推送才会中断。这是人们使用服务器推送的典型方式。

当浏览器发现“Content-type”头标或到达头标结束处时,浏览器窗口中的前一个文档被清除,并开始显示下一个文档。发现下一个报文边界时,就认为当前数据块(文档)已经结束。
总之,服务器推送的数据由一组头标(通常包括“Content-type”)、数据本身和分割符(报文边界)三部分组成。浏览器看到分割符时,它保持状态不变,直到下一个数据块到达。

捕获.JPG

TA的精华主题

TA的得分主题

发表于 2012-5-15 09:18 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
本帖最后由 xmyjk 于 2012-5-15 09:19 编辑
liucqa 发表于 2012-5-15 00:49
留个记号,崇拜中...

FIDDLER2,HTTPFOX等,是必须要下载完毕后,才可以捕获的,长连接,连接一直保持,其就误以为数据并未下载完毕,导致无法取数。其实数据一直再收包而已。

这类网站要用WSExplorer。http://www.cr173.com/soft/17693.html

TA的精华主题

TA的得分主题

发表于 2012-5-16 18:39 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
xmyjk 发表于 2012-5-14 21:59
需要安装WINSOCK,解压缩MSWINSCK.OCX,放置system32里面,然后注册。然后再VBE界面里面,引用里面,浏览, ...

基本上没看懂。

TA的精华主题

TA的得分主题

发表于 2012-5-16 18:58 | 显示全部楼层
Sub 霸灵财经网()
    On Error Resume Next
    With CreateObject("internetexplorer.application")
        .Navigate "http://www.baring.cn/quo/index.html"
        While .ReadyState <> 4 Or .Busy
            DoEvents
        Wend
        Set r = .Document.All.tags("table")(1).Rows
        For i = 0 To r.Length - 1
            For j = 0 To r(i).Cells.Length - 1
                Cells(i + 1, j + 1) = r(i).Cells(j).innerText
            Next j
        Next i
    .Quit
    End With
    Cells.Font.Size = 9
    Cells.Columns.AutoFit
    Set r = Nothing
End Sub

TA的精华主题

TA的得分主题

发表于 2012-5-16 19:23 | 显示全部楼层
霸灵财经网

霸灵财经网.rar

17.17 KB, 下载次数: 273

TA的精华主题

TA的得分主题

发表于 2012-5-17 00:48 | 显示全部楼层
本帖最后由 xmyjk 于 2012-5-17 00:50 编辑
蓝天630902 发表于 2012-5-16 19:23
霸灵财经网

呵呵,你这个点钟,数据是静态的。所以看不出效果。

你可以等一个有更新数据流的时间,例如晚上11点多,或者是早上,你就知道网页的页面效果了。

网页的数据是动态更新的,甚至,一秒钟都会更新一次,我模拟的就是网页的效果。

且数据更新,并不是靠刷新页面,而是和页面的加载方式一样,仅仅保持和服务器的链接没断开,继续收取后续的数据,而不是重新发包或者刷新页面。

TA的精华主题

TA的得分主题

发表于 2012-5-17 01:00 | 显示全部楼层
本帖最后由 xmyjk 于 2012-5-17 01:11 编辑
蓝天630902 发表于 2012-5-16 19:23
霸灵财经网

如图,一次发包,下载三页数据,且不断开和服务器的连接,并模拟网页动态更新的效果,实时更新数据,并不重新刷新页面或者重新发包。

我红和绿模拟的是网页的那个瞬间数据涨跌的小箭头,而不是涨跌噢。呵呵。
3215.gif
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

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

GMT+8, 2024-12-4 03:16 , Processed in 0.068349 second(s), 16 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

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

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

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