多网页数据导入excel，如何整合，高手挑战

有五龙

条件：
一个excel文件内七个工作表，其中：
第二个工作表：基金持仓，网址是http://data.eastmoney.com/zlsj/jj/201406/jgsl.html
第三个工作表：QFII持仓，网址是http://data.eastmoney.com/zlsj/qfii/201406/jgsl.html
第四个工作表：社保持仓，网址是http://data.eastmoney.com/zlsj/sb/201406/jgsl.html
第五个工作表：券商持仓，网址是http://data.eastmoney.com/zlsj/qs/201406/jgsl.html
第六个工作表：保险持仓，网址是http://data.eastmoney.com/zlsj/bx/201406/jgsl.html
第七个工作表：信托持仓，网址是http://data.eastmoney.com/zlsj/xt/201406/jgsl.html

要求：第一个工作表第一行有导入、清空按钮，点导入后面六个工作表将各自将网址第一页到最后一页数据导入各自工作表，点清空后面六个工作表全部清空。
详见附件。

有五龙

难度大   高手在哪里

百度不到去谷歌

难度不大 问题是谁愿意给你花那么多时间

有五龙

汗   那个猎取网址的软件是什么

有五龙

这是大神做的网站之一，汇总怎么改呀

suwenkai

1. Sub 基金持仓()
   
2.     Dim url, js, n
   
3.     url = "http://data.eastmoney.com/aspx/data.aspx"
   
4.     url = url & "?name=RptOrgFundPositions&reportDate=20140630"    '这里控制数据的日期
   
5.     url = url & "&page=1"    '这里控制数据是第几页
   
6.     url = url & "&pageSize=10000"    '这里控制数据一次可以提取多少股票
   
7.     url = url & "&sortType=2&sortRule=-1&jsname=suwenkai&changeType=All%20&rt=46964581"
   
8.         
   
9.     Call get_url(url)
   
10. End Sub
    
11. 
    
12. Sub QFII持仓()
    
13.     Dim url, js, n
    
14.     url = "http://data.eastmoney.com/aspx/data.aspx"
    
15.     url = url & "?name=RptOrganizationPositions&orgType=QFII&reportDate=20140630"    '这里控制数据的日期
    
16.     url = url & "&page=1"    '这里控制数据是第几页
    
17.     url = url & "&pageSize=10000"    '这里控制数据一次可以提取多少股票
    
18.     url = url & "&&sortType=2&sortRule=-1&jsname=suwenkai&changeType=All%20&rt=46964634"
    
19.         
    
20.     Call get_url(url)
    
21. End Sub
    
22. 
    
23. Sub 社保持仓()
    
24.     Dim url, js, n
    
25.     url = "http://data.eastmoney.com/aspx/data.aspx"
    
26.     url = url & "?name=RptOrganizationPositions&orgType=SocialInsuranceFund&reportDate=20140630"    '这里控制数据的日期
    
27.     url = url & "&page=1"    '这里控制数据是第几页
    
28.     url = url & "&pageSize=10000"    '这里控制数据一次可以提取多少股票
    
29.     url = url & "&&sortType=2&sortRule=-1&jsname=suwenkai&changeType=All%20&rt=46964634"
    
30.         
    
31.     Call get_url(url)
    
32. End Sub
    
33. Sub 券商持仓()
    
34.     Dim url, js, n
    
35.     url = "http://data.eastmoney.com/aspx/data.aspx"
    
36.     url = url & "?name=RptOrganizationPositions&orgType=Securities&reportDate=20140630"    '这里控制数据的日期
    
37.     url = url & "&page=1"    '这里控制数据是第几页
    
38.     url = url & "&pageSize=10000"    '这里控制数据一次可以提取多少股票
    
39.     url = url & "&&sortType=2&sortRule=-1&jsname=suwenkai&changeType=All%20&rt=46964634"
    
40.         
    
41.     Call get_url(url)
    
42. End Sub
    
43. Sub 保险持仓()
    
44.     Dim url, js, n
    
45.     url = "http://data.eastmoney.com/aspx/data.aspx"
    
46.     url = url & "?name=RptOrganizationPositions&orgType=Insurance&reportDate=20140630"    '这里控制数据的日期
    
47.     url = url & "&page=1"    '这里控制数据是第几页
    
48.     url = url & "&pageSize=10000"    '这里控制数据一次可以提取多少股票
    
49.     url = url & "&&sortType=2&sortRule=-1&jsname=suwenkai&changeType=All%20&rt=46964634"
    
50.         
    
51.     Call get_url(url)
    
52. End Sub
    
53. Sub 信托持仓()
    
54.     Dim url, js, n
    
55.     url = "http://data.eastmoney.com/aspx/data.aspx"
    
56.     url = url & "?name=RptOrganizationPositions&orgType=Intrust&reportDate=20140630"    '这里控制数据的日期
    
57.     url = url & "&page=1"    '这里控制数据是第几页
    
58.     url = url & "&pageSize=10000"    '这里控制数据一次可以提取多少股票
    
59.     url = url & "&&sortType=2&sortRule=-1&jsname=suwenkai&changeType=All%20&rt=46964634"
    
60.         
    
61.     Call get_url(url)
    
62. End Sub
    
63. 
    
64. 
    
65. 
    
66. Public Sub get_url(url)
    
67.     Set js = CreateObject("scriptcontrol")
    
68.     js.Language = "jscript"
    
69.     With CreateObject("msxml2.xmlhttp")
    
70.         .Open "get", url, False
    
71.         .send
    
72.         js.addcode (.responsetext)
    
73.         slen = js.eval("suwenkai.data.length")
    
74.         For i = 0 To slen - 1
    
75.             s = js.eval("suwenkai.data[" & i & "]")
    
76.             ar = Split(s, ",")
    
77.             Cells(i + 2, 1) = CStr(i + 1)
    
78.             Cells(i + 2, 2).Resize(1, UBound(ar)) = ar
    
79.             If Val(ar(6)) > 0 Then
    
80.                 Cells(i + 2, 9) = "增仓"
    
81.             ElseIf Val(ar(6)) = 0 Then
    
82.                 Cells(i + 2, 9) = "不变"
    
83.             Else
    
84.                 Cells(i + 2, 9) = "减仓"
    
85.             End If
    
86.         Next
    
87.     End With
    
88. End Sub
    
89. Sub 清除数据()
    
90.     Range("a2:i65536").ClearContents
    
91. End Sub
    

复制代码

有五龙

楼上是好人  太感谢了

Aifee_Li

第一次见，汇总网页的数据。

笨笨网络

suwenkai 发表于 2014-8-25 12:14

正是我需要的，谢谢了！

笨笨网络

suwenkai 发表于 2014-8-25 12:14

你好，现在网页变成这了，提取的数据不是最新的，代码怎么改？谢谢！