网抓应用之caipiaokaijiangshuju多方法查询

学不完用不尽

三种方法可对多种caipiao的历史数据查询。
程序主要代码由ccwan老师提供，在此向ccwan老师表示诚挚的感谢！

效果图：









多彩种多方法查询.rar (87.08 KB, 下载次数: 120)

2015-11-23 12:37 上传

点击文件名下载附件

huang1314wei

感谢分享，不买彩票的路过

学不完用不尽

昨天没分享成功，审核时说“有多处敏感词”，未通过审核，直接咔嚓掉了，今天又重新上传分享，把敏感词用拼音替代了，哈哈，这种障眼法居然通过审核了，分享成功。

学不完用不尽

huang1314wei 发表于 2015-11-23 12:44
感谢分享，不买彩票的路过

谢谢关注！
练习练习网抓。

huang1314wei

学不完用不尽 发表于 2015-11-23 12:49
昨天没分享成功，审核时说“有多处敏感词”，未通过审核，直接咔嚓掉了，今天又重新上传分享，把敏感词用拼 ...

论坛是禁用VBA来研究彩票的

学不完用不尽

huang1314wei 发表于 2015-11-23 12:57
论坛是禁用VBA来研究彩票的

原来如此，感谢提醒！
以后再在论坛里提问或分享时，尽量避开这些敏感词。

Kelidai

很不错的作品，借鉴。

学不完用不尽

Kelidai 发表于 2015-11-23 14:08
很不错的作品，借鉴。

谢谢捧场！
程序中的部分代码如下：

1. Sub 福彩双色球按期数查询() '福彩双色球自定义按期数查询，根据A1单元格的值，灵活提取开奖期数
   
2.     Dim URL, irow, oDoc, r, i, j
   
3.     Dim bt, fbt
   
4.     irow = Cells(Rows.Count, 1).End(xlUp).Row + 2
   
5.     Range("A2:L" & irow).Clear
   
6.     Range("c1:e1").Clear
   
7.     Range("c1") = "福彩双色球历史开奖数据"
   
8.     bt = Array("期号", "开奖日期", "开奖号码", "", "投注金额（元）", "一等奖", "", "二等奖", "", "奖池")
   
9.     fbt = Array("注数", "奖金（元）", "注数", "奖金（元）")
   
10.     Range("a2").Resize(1, 10) = bt
    
11.     Range("f3").Resize(1, 4) = fbt
    
12.     Range("c3") = "红球"
    
13.     Range("d3") = "蓝球"
    
14.     Application.DisplayAlerts = False
    
15.     Range("c1:e1").Merge
    
16.     Range("a2:a3").Merge
    
17.     Range("b2:b3").Merge
    
18.     Range("c2:d2").Merge
    
19.     Range("e2:e3").Merge
    
20.     Range("f2:g2").Merge
    
21.     Range("h2:i2").Merge
    
22.     Range("j2:j3").Merge
    
23.     With Range("a1:j3")
    
24.         .HorizontalAlignment = xlCenter
    
25.         .VerticalAlignment = xlCenter
    
26.     End With
    
27.     Application.DisplayAlerts = True
    
28.     URL = "http://chart.cp.360.cn/kaijiang/ssq?lotId=220051&spanType=0&span=" & [a1] & "&r=0.033004044787958264#roll_132/"
    
29.     Set oDoc = CreateObject("htmlfile")
    
30.     With CreateObject("msxml2.xmlhttp")
    
31.         .Open "get", URL, False
    
32.         .send
    
33.         oDoc.body.innerHTML = StrConv(.responsebody, vbUnicode)
    
34.     End With
    
35.     Set r = oDoc.All.tags("table")(1).Rows
    
36.     For i = 2 To r.Length - 1
    
37.         For j = 0 To r(i).Cells.Length - 2
    
38.             Cells(i + 2, j + 1) = r(i).Cells(j).innerText
    
39.         Next j
    
40.     Next i
    
41.     Application.ScreenUpdating = False
    
42.     Range("a1:j" & i + 1).Columns.AutoFit
    
43.     Range("a2:j" & i + 1).Borders.LineStyle = 1
    
44.     Application.ScreenUpdating = True
    
45. End Sub
    
46. Sub 福彩双色球按期号查询() '福彩双色球自定义按期号查询，根据A1单元格的起止期号，灵活提取开奖期数
    
47.     Dim URL, irow, oDoc, r, i, j
    
48.     Dim bt, fbt, qzqh
    
49.     irow = Cells(Rows.Count, 1).End(xlUp).Row + 2
    
50.     Range("A2:L" & irow).Clear
    
51.     Range("c1:e1").Clear
    
52.     Range("c1") = "福彩双色球历史开奖数据"
    
53.     bt = Array("期号", "开奖日期", "开奖号码", "", "投注金额（元）", "一等奖", "", "二等奖", "", "奖池")
    
54.     fbt = Array("注数", "奖金（元）", "注数", "奖金（元）")
    
55.     Range("a2").Resize(1, 10) = bt
    
56.     Range("f3").Resize(1, 4) = fbt
    
57.     Range("c3") = "红球"
    
58.     Range("d3") = "蓝球"
    
59.     Application.DisplayAlerts = False
    
60.     Range("c1:e1").Merge
    
61.     Range("a2:a3").Merge
    
62.     Range("b2:b3").Merge
    
63.     Range("c2:d2").Merge
    
64.     Range("e2:e3").Merge
    
65.     Range("f2:g2").Merge
    
66.     Range("h2:i2").Merge
    
67.     Range("j2:j3").Merge
    
68.     With Range("a1:j3")
    
69.         .HorizontalAlignment = xlCenter
    
70.         .VerticalAlignment = xlCenter
    
71.     End With
    
72.     Application.DisplayAlerts = True
    
73.     qzqh = Range("a1") & "_" & Range("b1")
    
74.    URL = "http://chart.cp.360.cn/kaijiang/ssq?lotId=220051&chartType=undefined&spanType=3&span=" & qzqh & "&r=0.22158218082040548#roll_132/"
    
75.     Set oDoc = CreateObject("htmlfile")
    
76.     With CreateObject("msxml2.xmlhttp")
    
77.         .Open "get", URL, False
    
78.         .send
    
79.         oDoc.body.innerHTML = StrConv(.responsebody, vbUnicode)
    
80.     End With
    
81.     Set r = oDoc.All.tags("table")(1).Rows
    
82.     For i = 2 To r.Length - 1
    
83.         For j = 0 To r(i).Cells.Length - 2
    
84.             Cells(i + 2, j + 1) = r(i).Cells(j).innerText
    
85.         Next j
    
86.     Next i
    
87.     Application.ScreenUpdating = False
    
88.     Range("a1:j" & i + 1).Columns.AutoFit
    
89.     Range("a2:j" & i + 1).Borders.LineStyle = 1
    
90.     Application.ScreenUpdating = True
    
91. End Sub
    
92. Sub 福彩双色球按日期查询() '福彩双色球自定义按日期查询，根据A1单元格的起止日期值，灵活提取开奖期数
    
93.     Dim URL, irow, oDoc, r, i, j
    
94.     Dim bt, fbt, qzrq
    
95.     irow = Cells(Rows.Count, 1).End(xlUp).Row + 2
    
96.     Range("A2:L" & irow).Clear
    
97.     Range("c1:e1").Clear
    
98.     Range("c1") = "福彩双色球历史开奖数据"
    
99.     bt = Array("期号", "开奖日期", "开奖号码", "", "投注金额（元）", "一等奖", "", "二等奖", "", "奖池")
    
100.     fbt = Array("注数", "奖金（元）", "注数", "奖金（元）")
     
101.     Range("a2").Resize(1, 10) = bt
     
102.     Range("f3").Resize(1, 4) = fbt
     
103.     Range("c3") = "红球"
     
104.     Range("d3") = "蓝球"
     
105.     Application.DisplayAlerts = False
     
106.     Range("c1:e1").Merge
     
107.     Range("a2:a3").Merge
     
108.     Range("b2:b3").Merge
     
109.     Range("c2:d2").Merge
     
110.     Range("e2:e3").Merge
     
111.     Range("f2:g2").Merge
     
112.     Range("h2:i2").Merge
     
113.     Range("j2:j3").Merge
     
114.     With Range("a1:j3")
     
115.         .HorizontalAlignment = xlCenter
     
116.         .VerticalAlignment = xlCenter
     
117.     End With
     
118.     Application.DisplayAlerts = True
     
119.     qzrq = Format(Range("a1"), "yyyy-mm-dd") & "_" & Format(Range("b1"), "yyyy-mm-dd")
     
120.    URL = "http://chart.cp.360.cn/kaijiang/ssq?lotId=220051&chartType=undefined&spanType=2&span=" & qzrq & "&r=0.09021096024662256#roll_132/"
     
121.     Set oDoc = CreateObject("htmlfile")
     
122.     With CreateObject("msxml2.xmlhttp")
     
123.         .Open "get", URL, False
     
124.         .send
     
125.         oDoc.body.innerHTML = StrConv(.responsebody, vbUnicode)
     
126.     End With
     
127.     Set r = oDoc.All.tags("table")(1).Rows
     
128.     For i = 2 To r.Length - 1
     
129.         For j = 0 To r(i).Cells.Length - 2
     
130.             Cells(i + 2, j + 1) = r(i).Cells(j).innerText
     
131.         Next j
     
132.     Next i
     
133.     Application.ScreenUpdating = False
     
134.     Range("a1:j" & i + 1).Columns.AutoFit
     
135.     Range("a2:j" & i + 1).Borders.LineStyle = 1
     
136.     Application.ScreenUpdating = True
     
137. End Sub
     

复制代码

学不完用不尽

如果你仔细看看代码，这些代码几乎一模一样，唯一有区别的就是URL（就是浏览器地址栏里的东东）的值不同而已，更改它就会变为另一种方法。

缔造者

体彩福彩一表网尽，赞一个！