小白也抓网——分享网抓作品

renahu

引子玄 发表于 2014-11-4 13:18
IE浏览器——是最老牌的浏览器，技术无可厚非，我一直喜欢使用IE浏览器。特别是对网抓者来说，使 ...

你能告诉我大小球最右侧“状态”中的“临”是怎么定位的吗？我知道“状态”在按时间顺序排列的每条数据中对应一个数，“早”是第一个，对应状态值是1，往上也是1，当变成3的时候就是“即”，那么“临”呢，“临”也是3，按第一个例子“即”的上面就是“临”，但别的例子就不是了，不知道什么规则？

renahu

VBA万岁 发表于 2014-11-10 20:35
如下（我输入的起页为1，终止页2）：

今天早上，一口气下来5000页，竟然没有断，决定试一下15000页。可能跟网络有关，就是确实太慢了

renahu

1. Sub 查询图书目录()                              '11月10日做了修改，查了一下共69118页，691177本书
   
2.     Dim strText As String, strHost As String, link As String, arr, brr()
   
3.     strHost = "http://www.apabi.com/cdyxy/"
   
4.     Cells.ClearContents
   
5.     Top = [{"封面网址","metaid","书名","作者","出版社","出版时间","编号"}]
   
6.     [a1].Resize(1, 7) = Top
   
7.     startPg = InputBox("请输入起始页码！", "起始页码")                                '起始页
   
8.     EndPg = InputBox("请输入结束页码！", "结束页码")                                  '结束页
   
9.     If startPg = "" Or EndPg = "" Then Exit Sub
   
10.     For p = startPg To EndPg                                                          '页数
    
11.         With CreateObject("MSXML2.XMLHTTP")
    
12.             .Open "GET", "http://www.apabi.com/cdyxy/?pid=usp.catsearch&db=dlib&dt=EBook&cult=CN&of=PublishDate&om=desc&ct=CYFL2011%24%24&cl=0&il=0&sct=1&pg=" & p & "&username=cdyxy00010&ug=成都医学院有密码用户组", False
    
13.             .Send
    
14.             strText = .ResponseText
    
15.             Debug.Print strText
    
16.             arr = Split(strText, "id=""1"" src=""")
    
17.             ReDim brr(0 To UBound(arr) - 1, 0 To 6)
    
18.             For i = 1 To UBound(arr)
    
19.                 brr(i - 1, 0) = strHost & Replace(Split(arr(i), """")(0), "amp;", "")
    
20.                 crr = Filter(Split(Split(Split(arr(i), "('")(1), "')")(0), "','"), "CYFL", False)
    
21.                 For j = 0 To UBound(crr)
    
22.                     brr(i - 1, j + 1) = crr(j)
    
23.                 Next
    
24.             Next
    
25.             [a2].Offset((p - startPg) * 10).Resize(UBound(brr) + 1, 7) = brr
    
26.         End With
    
27.     Next
    
28.     '加入超链接
    
29.     For i = 2 To [a65536].End(xlUp).Row   '循环E列各行
    
30.         link = Range("a" & i).Value
    
31.         ActiveSheet.Hyperlinks.Add Anchor:=Range("a" & i), Address:=link, TextToDisplay:="查看封面"
    
32.     Next
    
33. End Sub
    
34. 
    
35. 
    

复制代码

网址：http://www.apabi.com/cdyxy/?pid= ... l=0&il=0&sct=1&pg=1
账密：cdyxy00010//111111

renahu

1. Sub 自选股查询()                                                                                               '练习八
   
2. Dim url$, STxt1$, STxt2$, arr, brr(), crr(), drr(0 To 9) As String, myObj As Shape
   
3. Cells.Clear
   
4. For Each myObj In ActiveSheet.Shapes
   
5.     If Not myObj.Name Like "Button*" Then myObj.Delete
   
6. Next
   
7. [a:z].HorizontalAlignment = xlCenter
   
8. [a20:z20].Font.ColorIndex = 2
   
9. [a20:z20].Interior.Color = RGB(25, 156, 223)
   
10. Top = [{"代码","名称","最新价","涨跌幅","涨跌额","总手","现手","买入价","卖出价","换手","金额","市盈率d","最高","最低","开盘","昨收","涨速","振幅","均价","内盘","外盘","市净率","总股本","总市值","流通股本","流通市值"}]
    
11. [a20].Resize(1, 26) = Top
    
12. [a21:b65536].Font.ColorIndex = 32
    
13. [a21:a65536].NumberFormatLocal = "000000"
    
14. Range("c21:c65536, h21:i65536, m21:o65536, s21:s65536").NumberFormatLocal = "0.00"
    
15. Range("d21:d65536, q21:q65536").NumberFormatLocal = "[红色]#,##0.00%;[颜色10]-#,##0.00%"
    
16. [e21:e65536].NumberFormatLocal = "[红色]#,##0.00;[颜色10]-#,##0.00"
    
17. Range("l21:l65536, p21:p65536, v21:v65536").NumberFormatLocal = "0.00"
    
18. [f21:f65536].NumberFormatLocal = "0.00万"
    
19. Range("j21:j65536, r21:r65536").NumberFormatLocal = "0.00%"
    
20. [t21:t65536].NumberFormatLocal = "[颜色10]0.00万"
    
21. [u21:u65536].NumberFormatLocal = "[红色]0.00万"
    
22. Range("k21:k65536, w21:z65536").NumberFormatLocal = "0.00亿"
    
23. With CreateObject("msxml2.xmlhttp")
    
24.     '抓数据
    
25.     url = "http://nufm.dfcfw.com/EM_Finance2014NumericApplication/JS.aspx?ps=500&token=64a483cbad8b666efa51677820e6b21c&type=CT"
    
26.     url = url & "&cmd=6001981,0008512,0021042,0020172,3002052,0009972,0021612,6005841,0007012,6001001,6007561,0009772,3000772,0005032,6007701,6004601,"
    
27.     url = url & "6001711,6000731,6006801,6000501,6007761,6003451,6004981,6002891,6006771,0000632,6008311,6000881,0009172,6001181,6003431,0007682,6001511,"
    
28.     url = url & "0005622,6000301,6008371,0005632,6016281,6013181,6010091,6000361,6000161,0000012,6013981,6000281,6018571,0000022,6003831,0000242,6000481,"
    
29.     url = url & "6003761,0000312,6001591,6015881,0006162&sty=CTALL&cb=getStockFullInfo&js=([(x)],true)&0.6800919628846551"
    
30.     .Open "get", url, False
    
31.     .send
    
32.     '整理数据
    
33.     strText = Replace(Split(Split(.ResponseText, "([""")(1), """]")(0), "%", "")
    
34.     arr = Split(strText, """,""")
    
35.     ReDim brr(0 To UBound(arr), 0 To 37)
    
36.     ReDim crr(0 To UBound(arr), 0 To 26)
    
37.     For i = 0 To UBound(arr)
    
38.         For x = 0 To 37
    
39.             brr(i, x) = Split(arr(i), ",")(x)
    
40.         Next
    
41.     Next
    
42.     For i = 0 To UBound(brr)
    
43.         For x = 0 To UBound(brr, 2)
    
44.             Select Case x
    
45.             Case 1
    
46.             crr(i, 0) = brr(i, x)
    
47.             Case 2
    
48.             crr(i, 1) = brr(i, x)
    
49.             Case 3
    
50.             crr(i, 2) = IIf(brr(i, x) = "-", "    " & brr(i, x), brr(i, x))
    
51.             Case 4
    
52.             crr(i, 3) = IIf(brr(i, x) = "-", "    " & brr(i, x), Val(brr(i, x)) / 100)
    
53.             Case 5
    
54.             crr(i, 4) = IIf(brr(i, x) = "-", "    " & brr(i, x), brr(i, x))
    
55.             Case 6
    
56.             crr(i, 5) = IIf(brr(i, x) = "-", "    " & brr(i, x), Round(Val(brr(i, x)) / 10000, 2))
    
57.             Case 7
    
58.             crr(i, 6) = IIf(brr(i, x) = "-", "    " & brr(i, x), brr(i, x))
    
59.             Case 8
    
60.             crr(i, 7) = IIf(brr(i, x) = "-", "    " & brr(i, x), brr(i, x))
    
61.             Case 9
    
62.             crr(i, 8) = IIf(brr(i, x) = "-", "    " & brr(i, x), brr(i, x))
    
63.             Case 11
    
64.             crr(i, 9) = IIf(brr(i, x) = "-", "    " & brr(i, x), Val(brr(i, x)) / 100)
    
65.             Case 12
    
66.             crr(i, 10) = IIf(brr(i, x) = "-", "    " & brr(i, x), IIf(Round(Val(brr(i, x)) / 100000000, 2) > 1, Round(Val(brr(i, x)) / 100000000, 2) & "亿", Round(Val(brr(i, x)) / 10000, 2) & "万"))
    
67.             Case 13
    
68.             crr(i, 11) = IIf(brr(i, x) = "-", "    " & brr(i, x), brr(i, x))
    
69.             Case 14
    
70.             crr(i, 12) = IIf(brr(i, x) = "-", "    " & brr(i, x), brr(i, x))
    
71.             Case 15
    
72.             crr(i, 13) = IIf(brr(i, x) = "-", "    " & brr(i, x), brr(i, x))
    
73.             Case 16
    
74.             crr(i, 14) = IIf(brr(i, x) = "-", "    " & brr(i, x), brr(i, x))
    
75.             Case 17
    
76.             crr(i, 15) = IIf(brr(i, x) = "-", "    " & brr(i, x), brr(i, x))
    
77.             Case 10
    
78.             crr(i, 16) = IIf(brr(i, x) = "-", "    " & brr(i, x), Val(brr(i, x)) / 100)
    
79.             Case 18
    
80.             crr(i, 17) = IIf(brr(i, x) = "-", "    " & brr(i, x), Val(brr(i, x)) / 100)
    
81.             Case 22
    
82.             crr(i, 18) = IIf(brr(i, x) = "-", "    " & brr(i, x), brr(i, x))
    
83.             Case 23
    
84.             crr(i, 19) = IIf(brr(i, x) = "-", "    " & brr(i, x), Round(Val(brr(i, x)) / 10000, 2))
    
85.             Case 24
    
86.             crr(i, 20) = IIf(brr(i, x) = "-", "    " & brr(i, x), Round(Val(brr(i, x)) / 10000, 2))
    
87.             Case 28
    
88.             crr(i, 21) = brr(i, x)
    
89.             Case 29
    
90.             crr(i, 22) = Round(brr(i, x) / 100000000, 2)
    
91.             Case 30
    
92.             crr(i, 23) = Round(brr(i, x) / 100000000, 2)
    
93.             Case 31
    
94.             crr(i, 24) = Round(brr(i, x) / 100000000, 2)
    
95.             Case 32
    
96.             crr(i, 25) = Round(brr(i, x) / 100000000, 2)
    
97.             End Select
    
98.         Next
    
99.     Next
    
100.     Cells(1, 1).Select: ActiveSheet.Pictures.Insert "http://hqpiczs.dfcfw.com/em_quote2010pictureproducter/picture/0000011rsindex.png?r=1415412542192"
     
101.     Cells(1, 5).Select: ActiveSheet.Pictures.Insert "http://hqpiczs.dfcfw.com/em_quote2010pictureproducter/picture/3990012rsindex.png?r=1415425177569"
     
102.     Cells(1, 9).Select: ActiveSheet.Pictures.Insert "http://hqgnqhpic.eastmoney.com/EM_Futures2010PictureProducter/Index.aspx?imagetype=RSIndex&ID=IFDYLX1&r=1415412573131"
     
103.     Cells(1, 13).Select: ActiveSheet.Pictures.Insert "http://hqpiczs.dfcfw.com/em_quote2010pictureproducter/picture/3990062rsindex.png?r=1415412627193"
     
104.     Cells(1, 18).Select: ActiveSheet.Pictures.Insert "http://hqhkpic.eastmoney.com/EM_Quote2010PictureProducter/Index.aspx?ImageType=RSIndex&ID=1100005&r=1415412669387"
     
105.     Cells(12, 1).Select: ActiveSheet.Pictures.Insert "http://hqgbpic.eastmoney.com/mrchart/0021042.gif?=2013-03-17 14:47:43"
     
106.     Cells(12, 5).Select: ActiveSheet.Pictures.Insert "http://hqgbpic.eastmoney.com/mrchart/0020172.gif?=2013-03-17 14:47:43"
     
107.     Cells(12, 9).Select: ActiveSheet.Pictures.Insert "http://hqgbpic.eastmoney.com/mrchart/3002052.gif?=2013-03-17 14:47:43"
     
108.     Cells(12, 13).Select: ActiveSheet.Pictures.Insert "http://hqgjgppic.eastmoney.com/EM_Quote2010PictureProductor/Picture/INDU7RSINDEX.png?r=1415412817336"
     
109.     Cells(12, 18).Select: ActiveSheet.Pictures.Insert "http://hqgjgppic.eastmoney.com/EM_Quote2010PictureProductor/Picture/CCMP7RSINDEX.png?r=1415425260273"
     
110.     '往表里写数据
     
111.     [a21].Resize(UBound(crr) + 1, 26) = crr
     
112.     '设置颜色
     
113.     For i = 0 To UBound(crr)
     
114.         For j = 2 To UBound(crr, 2) - 7
     
115.             Select Case j
     
116.             Case 2, 7, 8, 12, 13, 14, 18
     
117.                 If crr(i, j) > crr(i, 15) Then
     
118.                     Cells(i + 21, j + 1).Font.ColorIndex = 3
     
119.                 ElseIf crr(i, j) < crr(i, 15) Then
     
120.                     Cells(i + 21, j + 1).Font.ColorIndex = 10
     
121.                 End If
     
122.             End Select
     
123.         Next
     
124.     Next
     
125.     '画表格线
     
126.     Cells.Borders.LineStyle = xlNone
     
127.     With Range("a21:z" & Range("a65536").End(xlUp).Row).Borders
     
128.         .LineStyle = xlContinuous
     
129.         .Weight = xlThin
     
130.         .ColorIndex = xlAutomatic
     
131.     End With
     
132. End With
     
133. End Sub
     

复制代码

这是平时炒股习惯看的自选股列表，几乎一模一样，你可以在此基础上自行修改。

引子玄

...................................

renahu

引子玄 发表于 2014-11-9 14:48
再给点网抓的理论给你，自己琢磨去

关于QT的认识误区——

还是老问题，大小球盘口中那个“临”怎么定位？

592rmb

引子玄 发表于 2014-11-9 14:48
再给点网抓的理论给你，自己琢磨去

关于QT的认识误区——

关于QT法，期待引子玄老师给几个例程讲解一下，先谢谢了！

VBA万岁

renahu 发表于 2014-11-9 13:53
这是平时炒股习惯看的自选股列表，几乎一模一样，你可以在此基础上自行修改。

功夫不负有心人——学吴姐的教程你最认真，进步也当数最快了。点赞！

blanksoul12

http://club.excelhome.net/thread-1163613-2-1.html
玩玩這個,我想知這個網站是不是有一些拒絕機制,我每次試兩三回便會再上不到了,要等一陣子才可再上,再試代碼兩三次又會再上不到,奇怪

renahu

blanksoul12 发表于 2014-11-9 18:10
http://club.excelhome.net/thread-1163613-2-1.html
玩玩這個,我想知這個網站是不是有一些拒絕機制,我每次 ...

这个是那个查图书的，登陆后，就可以抓到了，看52楼，不过好像登陆一段时间后会自动退出的