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

ck1668

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

xmyjk

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

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

ck1668

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

ck1668

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


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

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

xmyjk

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



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

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

xmyjk

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



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

删除B股后的，你试看看

ck1668

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

1005191301

老师,下面这个代码在打开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

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

整段代码如下：

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

复制代码

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

xmyjk

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

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

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

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