ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

EH搜索     
EH云课堂-专业的职场技能充电站 Excel转在线管理系统,怎么做看这里 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
Excel不给力? 何不试试FoxTable! Excel 2016函数公式学习大典 高效办公必会的Office实战技巧 免费下载Excel行业应用视频
300集Office 2010微视频教程 Tableau-数据可视化工具 精品推荐-800套精选PPT模板,点击获取 ExcelHome出品 - VBA代码宝免费下载
你的Excel 2010实战技巧学习锦囊 欲罢不能, 过目难忘的 Office 新界面 Excel VBA经典代码实践指南
查看: 1723|回复: 12

[分享] 网抓应用之caipiaokaijiangshuju多方法查询

[复制链接]

TA的精华主题

TA的得分主题

发表于 2015-11-23 12:37 | 显示全部楼层 |阅读模式
三种方法可对多种caipiao的历史数据查询。
程序主要代码由ccwan老师提供,在此向ccwan老师表示诚挚的感谢!

效果图:

按期数查询.jpg

按期号查询.jpg

按日期查询.jpg



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

TA的精华主题

TA的得分主题

发表于 2015-11-23 12:44 | 显示全部楼层
感谢分享,不买彩票的路过

TA的精华主题

TA的得分主题

 楼主| 发表于 2015-11-23 12:49 | 显示全部楼层
昨天没分享成功,审核时说“有多处敏感词”,未通过审核,直接咔嚓掉了,今天又重新上传分享,把敏感词用拼音替代了,哈哈,这种障眼法居然通过审核了,分享成功。

TA的精华主题

TA的得分主题

 楼主| 发表于 2015-11-23 12:54 | 显示全部楼层

TA的精华主题

TA的得分主题

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

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

TA的精华主题

TA的得分主题

 楼主| 发表于 2015-11-23 13:05 | 显示全部楼层
huang1314wei 发表于 2015-11-23 12:57
论坛是禁用VBA来研究彩票的

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

TA的精华主题

TA的得分主题

发表于 2015-11-23 14:08 | 显示全部楼层

TA的精华主题

TA的得分主题

 楼主| 发表于 2015-11-23 19:22 | 显示全部楼层
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
复制代码

TA的精华主题

TA的得分主题

 楼主| 发表于 2015-11-23 20:14 | 显示全部楼层
如果你仔细看看代码,这些代码几乎一模一样,唯一有区别的就是URL(就是浏览器地址栏里的东东)的值不同而已,更改它就会变为另一种方法。

TA的精华主题

TA的得分主题

发表于 2015-11-27 11:53 | 显示全部楼层
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

关注官方微信,每天学会一个新技能

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2019-8-24 06:39 , Processed in 0.095233 second(s), 14 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2020 Wooffice Inc.

   

沪公网安备 31011702000001号 沪ICP备11019229号

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:徐怀玉律师 李志群律师

快速回复 返回顶部 返回列表