ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
300集Office 2010微视频教程 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
楼主: WYS67

[求助] 用VBA按网页下拉框指定期号抓取所需内容

[复制链接]

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-12-2 09:07 | 显示全部楼层
本帖最后由 WYS67 于 2018-12-2 09:37 编辑
duquancai 发表于 2018-12-2 06:25
python3.7 高并发异步爬虫
抓取 2015-11-03 到 2018-12-01 的数据并写入Excel,总计运行时间在30秒内完 ...

20181202085944.png 20181202090414.png

老师:把代码复制粘贴进模块1后,许多内容变成了红色字体,并出现错误提示,这是怎么回事?

麻烦老师用新附件 按B1指定的网址和B2B3指定的期号下载开奖数据.zip (15.95 KB, 下载次数: 3) 作个范例上传。里面的两个工作表是《江苏快三》和《安徽快三》,要求按B1指定的网址,B2:B3指定的起止期号,分别下载对应的历史开奖数据。

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-12-2 12:06 | 显示全部楼层
duquancai 发表于 2018-12-2 06:25
python3.7 高并发异步爬虫
抓取 2015-11-03 到 2018-12-01 的数据并写入Excel,总计运行时间在30秒内完 ...

恳请老师帮忙:按照A1:B3的指定条件抓取网页数据。10楼的代码出现如11楼所描述的错误。

TA的精华主题

TA的得分主题

发表于 2018-12-2 12:23 来自手机 | 显示全部楼层

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-12-2 12:35 | 显示全部楼层
Kaohsing 发表于 2018-12-2 12:23
这是python不是vba。

怎么运行?代码复制粘贴到哪里?

TA的精华主题

TA的得分主题

发表于 2018-12-2 13:44 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2018-12-2 13:47 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
WYS67 发表于 2018-12-2 12:35
怎么运行?代码复制粘贴到哪里?

下载Python。在下载一些库,在下个idle,黏贴到idle

评分

1

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-12-2 14:17 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
Kaohsing 发表于 2018-12-2 13:47
下载Python。在下载一些库,在下个idle,黏贴到idle

这么复杂啊?从未用过啊?!

TA的精华主题

TA的得分主题

发表于 2018-12-2 14:29 | 显示全部楼层
  1. Sub Main()
  2.     Dim StDate As Date, EndDate As Date, tempDate As Date
  3.     Dim rsArr()
  4.    
  5.     Range("A5:C" & Cells(Rows.Count, 1).End(xlUp).Row + 1).ClearContents
  6.    
  7.     StDate = Format("20" & Left([B2].Value, 6), "0000/00/00")
  8.     EndDate = Format("20" & Left([B3].Value, 6), "0000/00/00")
  9.    
  10.     tempDate = StDate
  11.     Do
  12.         rsArr = getDataFromWebByDate(tempDate)
  13.         Range("A" & Cells(Rows.Count, 1).End(xlUp).Row + 1).Resize(UBound(rsArr), 3) = rsArr
  14.         tempDate = tempDate + 1
  15.     Loop Until tempDate > EndDate
  16.    
  17. End Sub

  18. Function getDataFromWebByDate(dDate As Date)
  19.     Dim strText As String, arr, brr, rsArr(), i%, j%
  20.    
  21.     With CreateObject("MSXML2.XMLHTTP")
  22.         .Open "GET", "http://kaijiang.500.com/static/info/kaijiang/xml/jsk3/" & Format(dDate, "yyyymmdd") & ".xml", False
  23.         .Send
  24.         strText = .responsetext
  25.     End With
  26.    
  27.     If InStr(strText, "404 Not Found") Then
  28.         ReDim rsArr(1 To 1, 1 To 3)
  29.         GoTo TheEnd
  30.     End If
  31.    
  32.     strText = Replace(strText, " expect=""", "|")
  33.     strText = Replace(strText, """ opencode=""", "|")
  34.     strText = Replace(strText, """ opentime=""", "|")
  35.     strText = Replace(strText, Chr(10), "")
  36.     strText = Replace(strText, """               />", "")
  37.    
  38.     arr = Split(strText, "<row")

  39.     ReDim rsArr(1 To UBound(arr), 1 To 3)
  40.     For i = 1 To UBound(arr)
  41.         brr = Split(arr(i), "|")
  42.         rsArr(i, 1) = brr(1)
  43.         rsArr(i, 2) = brr(3)
  44.         rsArr(i, 3) = brr(2)
  45.     Next
  46. TheEnd:
  47.     getDataFromWebByDate = rsArr
  48. End Function
复制代码

评分

1

查看全部评分

TA的精华主题

TA的得分主题

发表于 2018-12-2 14:46 | 显示全部楼层

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-12-2 15:19 | 显示全部楼层
本帖最后由 WYS67 于 2018-12-2 16:53 编辑

老师编写的代码很好!以最新附件只需修改21楼描述的几处,就能圆满实现我的心中所想:
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

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

GMT+8, 2024-3-29 23:23 , Processed in 0.051485 second(s), 9 queries , Gzip On, Redis On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

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

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

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