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

renahu

引子玄 发表于 2014-11-1 20:15
学好了就好，我给个题目，测试你学得如何？请接题——

这个网页里的“大小盘走势”指数，用fiddler方法如 ...

1. Sub 大小球盘口()                                                                        '练习五
   
2.     Dim strText$, arr, brr, crr(), drr(), err(), lab As Boolean, trr, ds
   
3.     Set ds = CreateObject("scripting.dictionary")
   
4.     Cells.Clear
   
5.     [a:f].HorizontalAlignment = xlCenter
   
6.     [a1:f1].Font.ColorIndex = 2
   
7.     [a1:f1].Interior.Color = RGB(25, 156, 223)
   
8.     Range("b1:b65536").NumberFormatLocal = "0.000"
   
9.     Range("d1:d65536").NumberFormatLocal = "0.000"
   
10.     Range("e1:e65536").NumberFormatLocal = "mm-dd hh:mm:ss"
    
11.     Top = Array("序", "大球", "大小球盘口", "小球", "变化时间", "状态")
    
12.     [a1].Resize(1, 6) = Top
    
13.     ActiveWindow.DisplayGridlines = True
    
14.     With CreateObject("MSXML2.XMLHTTP")
    
15.         .Open "GET", "http://fenxi.310v.net/odds_pic/panlu.html?match_id=939357&company_id=397", False
    
16.         .send
    
17.         strText = Split(Split(.responseText, "var BPK = [];")(1), "function sort_pk(d1,d2)")(0)
    
18.         strText = Left(strText, Len(strText) - 3)
    
19.         arr = Split(strText, ";")
    
20.         For i = 0 To UBound(arr)
    
21.             arr(i) = Replace(Replace(arr(i), "BPK[" & i + Split(Split(arr(i), "BPK[")(1), "]")(0) - i & "]=[", ""), "]", "")
    
22.             arr(i) = Right(arr(i), Len(arr(i)) - 1)
    
23.             ReDim Preserve drr(i)
    
24.             drr(i) = Split(arr(i), ",")(1)
    
25.             ReDim Preserve err(i)
    
26.             err(i) = Mid(Split(arr(i), ",")(0), 2, Len(Split(arr(i), ",")(0)) - 2)
    
27.         Next
    
28.         For i = 0 To UBound(err)
    
29.             ds(err(i)) = drr(i)
    
30.         Next
    
31.         .Open "GET", "http://fenxi.310v.net/data/panlu/panlu/939/b939357_397.js?d=1414914106552 ", False
    
32.         .send
    
33.         strText = Split(.responseText, "d3=[];")(1)
    
34.         strText = Left(strText, Len(strText) - 2)
    
35.         brr = Split(strText, ";")
    
36.         brr(0) = Replace(brr(0), "d3[0]=", "d3.push(") & ")"
    
37.         For i = 0 To UBound(brr)
    
38.             brr(i) = Replace(Replace(brr(i), "d3.push(""", ""), """)", "")
    
39.             brr(i) = Right(brr(i), Len(brr(i)) - 1)
    
40.             ReDim Preserve crr(0 To UBound(brr), 0 To 5)
    
41.             crr(i, 0) = i + 1
    
42.             For x = 0 To 4
    
43.                 crr(i, x + 1) = Split(brr(i), ",")(x)
    
44.             Next
    
45.             crr(i, 2) = err(crr(i, 2) - 1) & "球"
    
46.             If i > 0 Then
    
47.                 If ds(Split(crr(i, 2), "球")(0)) > ds(Split(crr(i - 1, 2), "球")(0)) Then
    
48.                     crr(i, 2) = crr(i, 2) & " 升"
    
49.                 ElseIf ds(Split(crr(i, 2), "球")(0)) < ds(Split(crr(i - 1, 2), "球")(0)) Then
    
50.                     crr(i, 2) = crr(i, 2) & " 降"
    
51.                 End If
    
52.                 If crr(i, 5) = 1 Then
    
53.                     crr(i, 5) = ""
    
54.                 ElseIf crr(i, 5) = 3 And crr(i - 1, 5) = "" And lab = False Then
    
55.                     crr(i, 5) = "即"
    
56.                 ElseIf crr(i, 5) = 3 And crr(i - 1, 5) = "即" Then
    
57.                     crr(i, 5) = "临"
    
58.                 ElseIf crr(i, 5) = 3 And crr(i - 1, 5) = "临" Then
    
59.                     crr(i, 5) = "": lab = True
    
60.                 ElseIf crr(i, 5) = 3 And lab = True Then
    
61.                     crr(i, 5) = ""
    
62.                 End If
    
63.             Else
    
64.                 crr(i, 5) = "早"
    
65.             End If
    
66.         Next
    
67.         '颠倒顺序
    
68.         trr = crr
    
69.         For i = UBound(crr) To 0 Step -1
    
70.           m = m + 1
    
71.           For j = 0 To UBound(crr, 2)
    
72.             trr(m - 1, j) = crr(i, j)
    
73.           Next
    
74.         Next
    
75.     End With
    
76.     Sheet1.[a2].Resize(UBound(trr) + 1, 6) = trr
    
77.         '设置颜色
    
78.     For j = 0 To UBound(trr, 2)
    
79.         Select Case j
    
80.         Case 1
    
81.             For i = UBound(trr) - 1 To 0 Step -1
    
82.                 If trr(i, j) > trr(i + 1, j) Then
    
83.                     Cells(i + 2, j + 1).Font.ColorIndex = 1
    
84.                     Cells(i + 2, j + 1).Interior.Color = RGB(255, 223, 223)
    
85.                 ElseIf trr(i, j) < trr(i + 1, j) Then
    
86.                     Cells(i + 2, j + 1).Font.ColorIndex = 1
    
87.                     Cells(i + 2, j + 1).Interior.Color = RGB(196, 255, 196)
    
88.                 End If
    
89.             Next
    
90.         Case 2
    
91.             For i = UBound(trr) - 1 To 0 Step -1
    
92.                 If Right(trr(i, j), 1) = "升" Then
    
93.                     Cells(i + 2, j + 1).Font.ColorIndex = 1
    
94.                     Cells(i + 2, j + 1).Interior.Color = RGB(255, 223, 223)
    
95.                     Cells(i + 2, j + 1).Characters(Start:=Len(Cells(i + 2, j + 1)), Length:=1).Font.ColorIndex = 3
    
96.                 ElseIf Right(trr(i, j), 1) = "降" Then
    
97.                     Cells(i + 2, j + 1).Font.ColorIndex = 1
    
98.                     Cells(i + 2, j + 1).Interior.Color = RGB(196, 255, 196)
    
99.                     Cells(i + 2, j + 1).Characters(Start:=Len(Cells(i + 2, j + 1)), Length:=1).Font.ColorIndex = 32
    
100.                 End If
     
101.             Next
     
102.         Case 3
     
103.             For i = UBound(trr) - 1 To 0 Step -1
     
104.                 If trr(i, j) > trr(i + 1, j) Then
     
105.                     Cells(i + 2, j + 1).Font.ColorIndex = 1
     
106.                     Cells(i + 2, j + 1).Interior.Color = RGB(255, 223, 223)
     
107.                 ElseIf trr(i, j) < trr(i + 1, j) Then
     
108.                     Cells(i + 2, j + 1).Font.ColorIndex = 1
     
109.                     Cells(i + 2, j + 1).Interior.Color = RGB(196, 255, 196)
     
110.                 End If
     
111.             Next
     
112.         Case 5
     
113.             For i = UBound(trr) To 0 Step -1
     
114.                 If trr(i, j) = "早" Then
     
115.                     Cells(i + 2, j + 1).Font.ColorIndex = 2
     
116.                     Cells(i + 2, j + 1).Interior.ColorIndex = 32
     
117.                 ElseIf trr(i, j) = "即" Then
     
118.                     Cells(i + 2, j + 1).Font.ColorIndex = 2
     
119.                     Cells(i + 2, j + 1).Interior.ColorIndex = 3
     
120.                 ElseIf trr(i, j) = "临" Then
     
121.                     Cells(i + 2, j + 1).Font.ColorIndex = 2
     
122.                     Cells(i + 2, j + 1).Interior.ColorIndex = 10
     
123.                 End If
     
124.             Next
     
125.         End Select
     
126.     Next
     
127.         '画表格线
     
128.     Cells.Borders.LineStyle = xlNone
     
129.     With Range("a1:f" & Range("a65536").End(xlUp).Row).Borders
     
130.         .LineStyle = xlContinuous
     
131.         .Weight = xlThin
     
132.         .ColorIndex = xlAutomatic
     
133.     End With
     
134.    
     
135. End Sub
     

复制代码

我在 blanksoul12 的基础上进行了精细化，并完全按照网上的格式和内容显示，几乎完全一样了。这抓的够全吧

renahu

blanksoul12 发表于 2014-11-2 17:35
又是笨笨的代碼,請問那些數據是否可以用JAVA分開呢?

我在你的基础上进行了精加工，把所有多余隐藏字符都干掉了，这活儿够细吧
网抓大小球.rar (163.16 KB, 下载次数: 240)

2014-11-4 18:03 上传

点击文件名下载附件

renahu

onlycxb 发表于 2014-11-2 07:54
全是百度网页，最好多换几个网页抓抓。

看看我的新作，精细版的网抓大小球

renahu

renahu 发表于 2014-11-4 17:58
我在 blanksoul12 的基础上进行了精细化，并完全按照网上的格式和内容显示，几乎完全一样了。这抓的够全吧 ...

这可是集各种技术啊，数据抓取，数据处理，颜色及表格处理，身为小白的我忙乎了几天，攻克了道道难关啊，终于问世了。

引子玄

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

renahu

引子玄 发表于 2014-11-4 18:48
你把“让球盘走势数据”和“胜平负走势数据”抓下来（这两块采集代码 blanksoul12 没写），也好证明自己是 ...

你这是激将法啊，呵呵，不过我觉得抓这些数据有什么用啊？你du球啊？

renahu

renahu 发表于 2014-11-4 18:50
你这是激将法啊，呵呵，不过我觉得抓这些数据有什么用啊？你du球啊？

你这个大小球网址的内容怎么总不变呀，怎么没有跟时间关联上，如果抓航班信息，一次弄好后，一点击都能自动更新，你这个网的内容怎么是死的？

renahu

再上一个图文并茂的，欧洲股指实时查询：

1. Sub 欧洲股市指数查询()                                                                      '练习六                     
   
2. Dim url$, STxt1$, STxt2$, arr, brr(), crr(), 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:j].HorizontalAlignment = xlCenter
   
8. [a21:a65536].HorizontalAlignment = xlLeft
   
9. [a20:j20].Font.ColorIndex = 2
   
10. [a20:j20].Interior.Color = RGB(25, 156, 223)
    
11. Range("b21:b65536").NumberFormatLocal = "0.00"
    
12. Range("c21:c65536").NumberFormatLocal = "0.00"
    
13. Range("e21:h65536").NumberFormatLocal = "0.00"
    
14. Range("j21:j65536").NumberFormatLocal = "mm-dd hh:mm"
    
15. Top = [{"指数名称","最新价","涨跌额","涨跌幅","最高","最低","开盘","昨收","振幅","最新行情时间"}]
    
16. [a20].Resize(1, 10) = Top
    
17. With CreateObject("msxml2.xmlhttp")
    
18.     '抓数据
    
19.     url = "http://hq2gjgp.eastmoney.com/EM_Quote2010NumericApplication/Index.aspx?reference=rtj&Type=Z&jsName=quote_global&ids=NKY7,KOSPI7,FSSTI7,TWSE7,SENSEX7,JCI7,VNINDEX7,FBMKLC7,SET7,KSE1007,PCOMP7,CSEALL7,AS517,NZSE50FG7,CASE7,INDU7,SPX7,CCMP7,SPTSX7,MEXBOL7,IBOV7,UKX7,DAX7,CAC7,IBEX7,FTSEMIB7,AEX7,SMI7,OMX7,ICEXI7,ISEQ7,INDEXCF7,ASE7,BEL207,LUXXX7,KFX7,HEX7,OBX7,ATX7,WIG7,PX7"
    
20.     .Open "get", url, False
    
21.     .send
    
22.     '整理数据
    
23.     strText = Split(Split(.responseText, """UKX7,UKX,")(1), "]}")(0)
    
24.     arr = Split(strText, """,""")
    
25.     arr(0) = "UKX7,UKX," & arr(0)
    
26.     ReDim Preserve brr(0 To UBound(arr), 0 To 32)
    
27.     ReDim Preserve crr(0 To UBound(arr), 0 To 9)
    
28.     For i = 0 To UBound(arr)
    
29.         For x = 0 To 32
    
30.             brr(i, x) = Split(arr(i), ",")(x)
    
31.         Next
    
32.     Next
    
33.     For i = 0 To UBound(brr)
    
34.         For x = 0 To UBound(brr, 2)
    
35.             Select Case x
    
36.             Case 2
    
37.             crr(i, 0) = brr(i, x)
    
38.             Case 5
    
39.             crr(i, 1) = brr(i, x)
    
40.             Case 10
    
41.             crr(i, 2) = brr(i, x)
    
42.             Case 11
    
43.             crr(i, 3) = brr(i, x)
    
44.             Case 6
    
45.             crr(i, 4) = brr(i, x)
    
46.             Case 7
    
47.             crr(i, 5) = brr(i, x)
    
48.             Case 4
    
49.             crr(i, 6) = brr(i, x)
    
50.             Case 3
    
51.             crr(i, 7) = brr(i, x)
    
52.             Case 13
    
53.             crr(i, 8) = brr(i, x)
    
54.             Case 28
    
55.             crr(i, 9) = brr(i, x)
    
56.             End Select
    
57.         Next
    
58.     Next
    
59.     '抓走势图地址
    
60.     url = "http://quote.eastmoney.com/center/europe.html"
    
61.     .Open "get", url, False
    
62.     .send
    
63.     strText = ByteToStr(.Responsebody, "GB2312")
    
64.     drr = Split(strText, "height=""135"" src=""")
    
65.     For i = 1 To UBound(drr)
    
66.         drr(i) = Split(drr(i), """ data-trade=""")(0)
    
67.     Next
    
68.     Cells(1, 1).Select: ActiveSheet.Pictures.Insert drr(1)
    
69.     Cells(12, 1).Select: ActiveSheet.Pictures.Insert drr(2)
    
70.     Cells(1, 5).Select: ActiveSheet.Pictures.Insert drr(3)
    
71.     Cells(12, 5).Select: ActiveSheet.Pictures.Insert drr(4)
    
72.     Cells(1, 9).Select: ActiveSheet.Pictures.Insert drr(5)
    
73.     Cells(12, 9).Select: ActiveSheet.Pictures.Insert drr(6)
    
74.     '往表里写数据
    
75.     [a21].Resize(UBound(crr) + 1, 10) = crr
    
76.     '设置颜色
    
77.     Range("a21:a" & Range("a65536").End(xlUp).Row).Font.ColorIndex = 32
    
78.     For i = 0 To UBound(crr)
    
79.         For j = 1 To UBound(crr, 2) - 3
    
80.             Select Case j
    
81.             Case 1, 4, 5, 6
    
82.                 If crr(i, j) > crr(i, 7) Then
    
83.                     Cells(i + 21, j + 1).Font.ColorIndex = 3
    
84.                 ElseIf crr(i, j) < crr(i, 7) Then
    
85.                     Cells(i + 21, j + 1).Font.ColorIndex = 10
    
86.                 End If
    
87.             Case 3
    
88.                 If Left(crr(i, j), Len(crr(i, j)) - 1) > 0 Then
    
89.                     Cells(i + 21, j + 1).Font.ColorIndex = 3
    
90.                 ElseIf Left(crr(i, j), Len(crr(i, j)) - 1) < 0 Then
    
91.                     Cells(i + 21, j + 1).Font.ColorIndex = 10
    
92.                 End If
    
93.             Case Else
    
94.                 If crr(i, j) > 0 Then
    
95.                     Cells(i + 21, j + 1).Font.ColorIndex = 3
    
96.                 ElseIf crr(i, j) < 0 Then
    
97.                     Cells(i + 21, j + 1).Font.ColorIndex = 10
    
98.                 End If
    
99.             End Select
    
100.         Next
     
101.     Next
     
102.     '画表格线
     
103.     Cells.Borders.LineStyle = xlNone
     
104.     With Range("a20:j" & Range("a65536").End(xlUp).Row).Borders
     
105.         .LineStyle = xlContinuous
     
106.         .Weight = xlThin
     
107.         .ColorIndex = xlAutomatic
     
108.     End With
     
109. End With
     
110. End Sub
     
111. Function ByteToStr(arrByte, strCharset As String) As String
     
112.     With CreateObject("Adodb.Stream")
     
113.         .Type = 1 'adTypeBinary
     
114.         .Open
     
115.         .Write arrByte
     
116.         .Position = 0
     
117.         .Type = 2 'adTypeText
     
118.         .Charset = strCharset
     
119.         ByteToStr = .Readtext
     
120.         .Close
     
121.     End With
     
122. End Function
     
123. 
     

复制代码

renahu

onlycxb 发表于 2014-11-4 16:50
你这个徒手擒拿，如能讲解一下最好，也算是造福网民。

老师，看看这个如何，图文并茂，还是实时的
网抓欧股指数.rar (56.86 KB, 下载次数: 183)

2014-11-5 19:48 上传

点击文件名下载附件

renahu

引子玄 发表于 2014-11-4 18:48
你把“让球盘走势数据”和“胜平负走势数据”抓下来（这两块采集代码 blanksoul12 没写），也好证明自己是 ...

这个欧股股指实时查询还是比较实用