[已解决]关于复制网上数据的问题

guodong321654 · 发表于 2015-4-12 08:08

本帖最后由 guodong321654 于 2015-4-12 08:14 编辑

新浪网上有提供股票成交数据明细，不过是当天成交信息是6点以后提供下载，即时信息股票买卖时下载不了，只得复制而复制太麻烦，新浪有好几个子网页必须逐步打开一一复制到excel上，然后再按时间排序，请教各位老师有比较好的简单方法或程序，实现一次性信息提取，谢谢。比如深中华A的股票4月12日从开盘到上午收盘时间段股票成交明细的提取。网址

网址.rar (3.03 KB, 下载次数: 13)

雪舞子 · 发表于 2015-4-13 11:07

今年股市不错，祝楼主发大财。

新浪股市当日即时股票成交明细：

Sub 成交明细()
Dim url, ul, html, tb, i&, j&, k&, dm, iRow
dm = [j1].Value
If Len(CStr(dm)) <> 6 Or IsNumeric(dm) = False Then Exit Sub
If Left(dm, 1) = "6" Then dm = "sh" & dm Else dm = "sz" & dm
url = "http://vip.stock.finance.sina.com.cn/quotes_service/view/vMS_tradedetail.php?"
url = url & "symbol=" & dm
url = url & "&date=" & Format(Date, "yyyy-mm-dd")
url = url & "&page="
[a2:g9999] = "": [k1] = "获取中..."
Set html = CreateObject("htmlfile")
With CreateObject("msxml2.xmlhttp")
For k = 1 To 100
ul = url & k
iRow = [a65536].End(3).Row
.Open "get", ul, False
.send
html.body.innerhtml = StrConv(.ResponseBody, vbUnicode)
Set tb = html.all.tags("table")(3).Rows
For i = 1 To tb.Length - 1
For j = 0 To tb(i).Cells.Length - 1
If IsNumeric(Left(tb(i).Cells(0).innertext, 1)) = False Then [k1] = "": MsgBox "获取完成！": Exit Sub
Cells(iRow + i, j + 1) = tb(i).Cells(j).innertext
Next
Next
Next
End With
[k1] = ""
End Sub

复制代码

成交明细.rar (38.63 KB, 下载次数: 16)

guodong321654 · 发表于 2015-4-19 08:40

你好，这几天忙没有来看，首先谢谢你给我发的程序，但打开发现还是提取不了信息

guodong321654 · 发表于 2015-4-19 08:41

雪舞子发表于 2015-4-13 11:07
今年股市不错，祝楼主发大财。

新浪股市当日即时股票成交明细：

你好，这几天忙没有来看，首先谢谢你给我发的程序，但打开发现还是提取不了信息

雪舞子 · 发表于 2015-4-19 08:57

guodong321654 发表于 2015-4-19 08:41
你好，这几天忙没有来看，首先谢谢你给我发的程序，但打开发现还是提取不了信息

提取的是当日成交明细，
休盘是没有数据的，
交易日再试。

guodong321654 · 发表于 2015-4-19 17:06

雪舞子发表于 2015-4-19 08:57
提取的是当日成交明细，
休盘是没有数据的，
交易日再试。

我把你程序的时间改为2015-04-17,试着提取，但提取不了
Sub 成交明细()
Dim url, ul, html, tb, i&, j&, k&, dm, iRow
dm = [j1].Value
If Len(CStr(dm)) <> 6 Or IsNumeric(dm) = False Then Exit Sub
If Left(dm, 1) = "6" Then dm = "sh" & dm Else dm = "sz" & dm
url = "http://vip.stock.finance.sina.com.cn/quotes_service/view/vMS_tradedetail.php?"
url = url & "symbol=" & dm
url = url & "&date=" & "2015-04-17"
url = url & "&page="
[a2:g9999] = "": [k1] = "获取中..."
Set html = CreateObject("htmlfile")
With CreateObject("msxml2.xmlhttp")
      For k = 1 To 100
         ul = url & k
         iRow = [a65536].End(3).Row
         .Open "get", ul, False
         .send
         html.body.innerhtml = StrConv(.ResponseBody, vbUnicode)
         Set tb = html.all.tags("table")(3).Rows
         For i = 1 To tb.Length - 1
            For j = 0 To tb(i).Cells.Length - 1
                  If IsNumeric(Left(tb(i).Cells(0).innertext, 1)) = False Then [k1] = "": MsgBox "获取完成！": Exit Sub
                  Cells(iRow + i, j + 1) = tb(i).Cells(j).innertext
            Next
         Next
      Next
End With
[k1] = ""
End Sub

雪舞子 · 发表于 2015-4-19 19:57

guodong321654 发表于 2015-4-19 17:06
我把你程序的时间改为2015-04-17,试着提取，但提取不了
Sub 成交明细()
Dim url, ul, html, tb, i& ...

你想要历史行情明细还是当日即时行情明细，

它们网址都不同，你能试出来吗？

历史行情数据可以去新浪网站直接去下载，

即时行情只有交易日才提供。

guodong321654 · 发表于 2015-4-20 13:53

雪舞子发表于 2015-4-19 19:57
你想要历史行情明细还是当日即时行情明细，

它们网址都不同，你能试出来吗？

我试过里，非常实用，谢谢，你太厉害了，你有QQ号么，相加你为朋友

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

[已解决]关于复制网上数据的问题

相关帖子