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

ck1668 · 发表于 2011-5-2 10:11

啊，对了，老师，9字头和2字头的B股能不能不要，因我炒的是A股，谢谢！

xmyjk · 发表于 2011-5-2 11:11

原帖由 ck1668 于 2011-5-2 10:11 发表
啊，对了，老师，9字头和2字头的B股能不能不要，因我炒的是A股，谢谢！

原始表里面没法不要，因为是网站源就是这样的，统计表里面可以。

ck1668 · 发表于 2011-5-2 13:12

老师，我看的就是统计表，原始表我一般不去看的，那就麻烦你帮我把统计表里面的B股删除，谢谢！

ck1668 · 发表于 2011-5-3 21:35

原帖由 xmyjk 于 2011-5-1 14:12 发表

这个比较麻烦，我研究研究，这几天比较忙，看看明天下午能不能给你答复。看看有没什么解决方式，直接插入统计表方式要整体修改工程，做工较大，看看有没什么好的解决方式就是。

老师，如果修改工程太大的话，就帮我把统计表里面的B股删除掉就好了。

xmyjk · 发表于 2011-5-3 22:24

原帖由 ck1668 于 2011-5-3 21:35 发表

老师，如果修改工程太大的话，就帮我把统计表里面的B股删除掉就好了。

不好意思，这两天事情比较多，空闲下来时候就抽空改改这东东。

xmyjk · 发表于 2011-5-3 23:37

原帖由 ck1668 于 2011-5-3 21:35 发表

老师，如果修改工程太大的话，就帮我把统计表里面的B股删除掉就好了。

删除B股后的，你试看看

ck1668 · 发表于 2011-5-4 08:53

老师，B股好像没有了，谢谢你，同时，对修改这表而耽误你的事情，以及这么晚还在帮我修改，内心除了深表歉意外，真的是非常感谢你！

1005191301 · 发表于 2011-5-4 11:40

老师,下面这个代码在打开EXCE后第1次可以刷新，第2次后刷新就还是老数据，能否怎样改一下呢？
另外：直接用浏览器打开：http://hqdigi2.eastmoney.com/EM_ ... page=1&style=33" 这个后，又可以刷新1次，是啥原因呢

Option Explicit
Sub Test()
Dim tmp() As String, i As Long, arr() As String, xmlhttp As Object, N As Long
Sheets("east").Select
Cells.Select
Selection.ClearContents

'[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

xmyjk · 发表于 2011-5-4 12:36

原帖由 1005191301 于 2011-5-4 11:40 发表
老师,下面这个代码在打开EXCE后第1次可以刷新，第2次后刷新就还是老数据，能否怎样改一下呢？
另外：直接用浏览器打开：http://hqdigi2.eastmoney.com/EM_ ... ype=s&sortType= ...

XMLHTTP的缓存没有重新加载，因此新的数据进不来，
把网址改为：
http://hqdigi2.eastmoney.com/EM_Quote2010NumericApplication/index.aspx?type=s&sortType=C&sortRule=-1&pageSize=5000&page=1&style=33&" & rnd()

整段代码如下：

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&" & Rnd(), 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

复制代码

[ 本帖最后由 xmyjk 于 2011-5-4 12:40 编辑 ]

xmyjk · 发表于 2011-5-4 12:45

原帖由 ck1668 于 2011-5-4 08:53 发表
老师，B股好像没有了，谢谢你，同时，对修改这表而耽误你的事情，以及这么晚还在帮我修改，内心除了深表歉意外，真的是非常感谢你！

没事，问题解决了就好，不必歉意，只需有空时候也学学VBA就行了，毕竟受人以鱼不如授之以渔，毕竟以后工具的调试我不可能永远一直跟踪下去，慢慢的你要开始学会调试和局部修改就是，最好能看懂代码原理就是。

另外大盘走势，我有个思路，我不打算做在工作表里面（因为做进去的话调整非常大），我打算做成窗体。看看吧，晚上或明天整个看看，取数据的已经做好了，就差一个我合意的窗体了。

[ 本帖最后由 xmyjk 于 2011-5-4 12:46 编辑 ]

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

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

删除B股后的，你试看看

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