[已解决]请教用EXCEL解析网站的可能性

demon558

谢谢老师，辛苦了
我要提取的是所有开奖号中每一期的前三位。。如

期数        开奖号码                                
13051658        9        5        8        3        1
13051659        3        11        6        8        4
13051660        10        5        11        1        8
改成下面这样
期数        开奖号码               
13051658        9        5        8
13051659        3        11        6
13051660        10        5      

另外也要全部每一期5个号

所有数据指 从fjtc.com.cn/Line-1105到fjtc.com.cn/Line-1105?Page=4的号码
是我没说清楚，不好意思

demon558

前三的不需要了，只要全部的就好

hwc2ycy

1. Sub 查询福彩前4页()
   
2. 
   
3.     Dim strDate$
   
4.     Dim strUrl$
   
5.     Dim strText$
   
6.     Dim strFind$
   
7.     Dim arr1, arr2, result(1 To 400, 1 To 6)
   
8.     Dim i As Long, j As Byte, k As Byte, m As Integer
   
9.     Dim httpRequest As Object
   
10.     Dim btPage As Byte
    
11.     m = 1
    
12.     '标题
    
13.     result(m, 1) = "期数"
    
14.     result(m, 2) = "开奖号码"
    
15. 
    
16.     For btPage = 1 To 4
    
17. 
    
18.         strUrl = "http://fjtc.com.cn/Line-1105?Page=" & btPage
    
19.         Set httpRequest = CreateObject("Msxml2.XMLHTTP.3.0")
    
20.         With httpRequest
    
21.             .Open "GET", strUrl, False
    
22.             .send
    
23.             strText = .responseText
    
24.         End With
    
25. 
    
26.         strFind = "<table class=""cpzs_table mt10"">"
    
27.         strText = Split(strText, strFind)(1)
    
28.         strText = Split(strText, "</table>")(0)
    
29.         arr1 = Split(strText, "</tr>")
    
30. 
    
31.         For j = 4 To UBound(arr1)
    
32.             If arr1(j) Like "<tr><td>*" Then
    
33.                 arr2 = Split(arr1(j), "</td>")
    
34.                 m = m + 1
    
35.                 '第1列期数
    
36.                 result(m, 1) = Split(Split(arr1(j), "</td")(0), "<td>")(1)
    
37.                 '第2列到6列
    
38.                 For k = LBound(arr2) + 1 To UBound(result, 2) - 1
    
39.                     result(m, k + 1) = Split(Split(arr2(k), "<span class=""spNum"">")(1), "<")(0)
    
40.                 Next
    
41.             Else
    
42.                 Exit For
    
43.             End If
    
44.         Next
    
45.     Next
    
46. 
    
47.     Application.ScreenUpdating = False
    
48. 
    
49.     With Range("a1")
    
50.         .CurrentRegion.ClearContents
    
51.         .Resize(m, UBound(result, 2)).Value = result
    
52.         .CurrentRegion.EntireColumn.AutoFit
    
53.     End With
    
54.     Range("B1:F1").HorizontalAlignment = xlCenterAcrossSelection
    
55. 
    
56.     Application.ScreenUpdating = True
    
57.     MsgBox "提取完成"
    
58. End Sub
    

复制代码