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

lzh8221

格式为：

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

枫叶乘风

excel中怎么样多个数据导入

xmyjk

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

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

复制代码

lzh8221

非常感谢 上旋下弦月

ck1668

原帖由 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)

2011-4-15 19:18 上传

点击文件名下载附件

xmyjk

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



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

907243

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

ck1668

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

xmyjk

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

复制代码

ck1668

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