请高手帮忙：多个网页数据导入excel

lzh8221 · 发表于 2011-4-6 15:10

格式为：

一张EXCEL表，横向为数据指标，纵向为股票名称，可以以前前辈的
几个例子，有点类似，又有点不同，由于本人对VBA还是初级阶段，现特意
请高手帮忙，具体的网页为：http://quote.eastmoney.com/center/list.html#33
谢谢！

枫叶乘风 · 发表于 2011-4-6 15:36

excel中怎么样多个数据导入

xmyjk · 发表于 2011-4-6 18:15

http://hqdigi2.eastmoney.com/EM_ ... page=1&style=33

hqdigi2.eastmoney.com/EM_Quote2010NumericApplication/index.aspx?type=s&sortType=C&sortRule=-1&pageSize=3000&page=1&style=33

所有数据都在里面啦

xmyjk · 发表于 2011-4-6 21:46

Option Explicit
Sub Test()
Dim tmp() As String, i As Long, arr() As String, xmlhttp As Object, N As Long
[A1].CurrentRegion.Clear
[a1:ae1] = Split("1a,代码,股票名称,昨收,今开,最新价,最高,最低,成交额,成交量,涨跌额,涨跌幅,均价,振幅,委比,委差,现手,内盘,外盘,20t,21u,5分钟涨跌幅,量比,换手,市盈,26z,27aa,28ab,更新时间,30ad,31ae", ",")
Set xmlhttp = CreateObject("Microsoft.XMLHTTP")
With xmlhttp
.Open "get", "http://hqdigi2.eastmoney.com/EM_Quote2010NumericApplication/index.aspx?type=s&sortType=C&sortRule=-1&pageSize=5000&page=1&style=33", False
.send
tmp() = Split(Split(Split(Replace(.responsetext, """,""", ","), "{rank:[""")(1), """]")(0), ",")
End With
ReDim arr(UBound(tmp) \ 31, 30)
For i = 0 To UBound(tmp)
arr(i \ 31, i Mod 31) = tmp(i)
Next
[a2].Resize(UBound(arr, 1) + 1, UBound(arr, 2) + 1) = arr
[a:ae].Columns.AutoFit
Union(Columns(1), Columns(20), Columns(21), Columns(26), Columns(27), Columns(28), Columns(30), Columns(31)).ColumnWidth = 0
Erase tmp
Erase arr
Set xmlhttp = Nothing
MsgBox "Ok"
End Sub

复制代码

lzh8221 · 发表于 2011-4-7 13:44

非常感谢上旋下弦月

ck1668 · 发表于 2011-4-15 19:18

原帖由 xmyjk 于 2011-4-6 18:15 发表
 http://hqdigi2.eastmoney.com/EM_ ... page=1&style=33

hqdigi2.eastmoney.com/EM_Quote2010NumericApplication/index.aspx?ty ...

仁兄，你好！小弟想套用你这个表格导入下面这个网页数据，却好像不行，请帮你我修改一下代码，多谢先了！
http://data.eastmoney.com/zjlx/detail.html

Book1.zip (1.83 KB, 下载次数: 48)

xmyjk · 发表于 2011-4-15 20:14

原帖由 ck1668 于 2011-4-15 19:18 发表

仁兄，你好！小弟想套用你这个表格导入下面这个网页数据，却好像不行，请帮你我修改一下代码，多谢先了！
http://data.eastmoney.com/zjlx/detail.html

907243

实际提供数据的网址：http://data.eastmoney.com/zjlx/data_detail.js

ck1668 · 发表于 2011-4-15 20:26

我试过，不行，出现一个对话框，提示：
运行时错误'-2146697211(800c0005)':
系统未找到指定的资源。

xmyjk · 发表于 2011-4-15 20:43

Option Explicit
Sub test()
Dim tmp() As String, i As Integer, arr() As String, xmlhttp As Object, N As Long
N = [a65536].End(xlUp).Row + 1
[a1:m1] = Split("代码,2B,3c,名称,最新价,涨跌幅,流入(万),流出(万),净流入(万),净流入占比,大单净流入(万),中单净流入(万),小单净流入(万)", ",")
Set xmlhttp = CreateObject("Microsoft.XMLHTTP")
With xmlhttp
.Open "get", "http://data.eastmoney.com/zjlx/data_detail.js", False
.send
tmp = Split(Split(Split(Replace(StrConv(.responsebody, vbUnicode, &H804), """,""", ","), "=[""")(1), """];")(0), ",")
End With
ReDim arr(UBound(tmp) \ 13, 12)
For i = 0 To UBound(tmp)
arr(i \ 13, i Mod 13) = tmp(i)
Next
[a2].Resize(UBound(arr, 1) + 1, UBound(arr, 2) + 1) = arr
[a:m].Columns.AutoFit
Columns("b:c").Hidden = 1
Erase tmp
Erase arr
Set xmlhttp = Nothing
MsgBox "Ok"
End Sub

复制代码

ck1668 · 发表于 2011-4-15 21:22

试过，正是我想要的，太感谢你了！

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

[求助] 请高手帮忙：多个网页数据导入excel

做好了，代码如下，EXCEL见附件

试看看，代码如下，excel见附件

[求助] 请高手帮忙： 多个网页数据导入excel

做好了，代码如下，EXCEL见附件

试看看，代码如下，excel见附件

[求助] 请高手帮忙：多个网页数据导入excel