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-3 09:24 | 显示全部楼层

嗯,这次完全实现了我心中所想!只是为什么《江苏快三》B列下边显示的日期时间是  2016-08-01 12:50:00" typebyclass="two-not-same" typebylabel=""/>,正确的应该是只显示前边的    2016-08-01 12:50:00   啊!
而《安徽快三》B列下边显示的日期时间是   2015-11-06 14:30:00" typebyclass="junko" typebylabel="˳"/>   正确的应该是只显示前边的    2015-11-06 14:30:00   啊!

20181203091710.png 20181203091729.png





TA的精华主题

TA的得分主题

发表于 2018-12-3 10:13 | 显示全部楼层
WYS67 发表于 2018-12-3 09:24
嗯,这次完全实现了我心中所想!只是为什么《江苏快三》B列下边显示的日期时间是  2016-08-01 12:50:00"  ...

因为以前的网页格式和后面的有所区别,在代码里没有删除干净,这只是少量的,所以手动删除一下就可以了。

TA的精华主题

TA的得分主题

发表于 2018-12-3 10:26 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
WYS67 发表于 2018-12-3 09:24
嗯,这次完全实现了我心中所想!只是为什么《江苏快三》B列下边显示的日期时间是  2016-08-01 12:50:00"  ...

你可以把37-51行代码,替换成下面的代码,可以去掉以前网页里的除日期外的内容:
  1. strText = Replace(strText, " expect=""", "|")
  2.     strText = Replace(strText, """ opencode=""", "|")
  3.     strText = Replace(strText, """ opentime=""", "|")
  4.     strText = Replace(strText, Chr(10), "")
  5.     strText = Replace(strText, """               />", "")
  6.     strText = Replace(strText, "</xml>", "")
  7.    
  8.     arr = Split(strText, "<row")

  9.     ReDim rsArr(1 To UBound(arr), 1 To 3)
  10.     For i = 1 To UBound(arr)
  11.         brr = Split(arr(i), "|")
  12.         rsArr(i, 1) = brr(1)
  13.         If InStr(brr(3), "type") Then
  14.             brr(3) = Left(brr(3), InStr(brr(3), """ type") - 1)
  15.         End If
  16.         rsArr(i, 2) = brr(3)
  17.         rsArr(i, 3) = brr(2)
  18.     Next
复制代码

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-12-3 11:17 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
mzbao 发表于 2018-12-3 10:26
你可以把37-51行代码,替换成下面的代码,可以去掉以前网页里的除日期外的内容:

可以把37-51行代码,替换成下面的代码后,B:C列仍然显示其它内容: 20181203111707.png

TA的精华主题

TA的得分主题

发表于 2018-12-3 13:10 来自手机 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
WYS67 发表于 2018-12-3 11:17
可以把37-51行代码,替换成下面的代码后,B:C列仍然显示其它内容:

用Python 和库pandas
把你的需求 在1到2分钟内 所有的数据及你需求一锅端了。

TA的精华主题

TA的得分主题

发表于 2018-12-3 13:32 | 显示全部楼层
给你换一个方法,这个应该不会出现其它字符了。
  1. Sub Main()
  2.     Dim StDate As Date, EndDate As Date, tempDate As Date, ShengFen$
  3.     Dim rsArr()
  4.    
  5.     Range("A5:C" & Cells(Rows.Count, 1).End(xlUp).Row + 1).ClearContents
  6.    
  7.     ShengFen = [B1].Value
  8.     ShengFen = Mid(ShengFen, InStrRev(ShengFen, "/") + 1)
  9.     ShengFen = Left(ShengFen, InStr(ShengFen, "k3.") - 1)

  10.     StDate = Format("20" & Left([B2].Value, 6), "0000/00/00")
  11.     EndDate = Format("20" & Left([B3].Value, 6), "0000/00/00")
  12.    
  13.     tempDate = EndDate
  14.     Do
  15.         rsArr = getDataFromWebByDate(tempDate, ShengFen)
  16.         Range("A" & Cells(Rows.Count, 1).End(xlUp).Row + 1).Resize(UBound(rsArr), 3) = rsArr
  17.         tempDate = tempDate - 1
  18.     Loop Until tempDate < StDate
  19.    
  20. End Sub

  21. Function getDataFromWebByDate(dDate As Date, ShengFen As String)
  22.     Dim XmlDoc As Object, oNodes As Object, el, k%
  23.     Dim rsArr()
  24.    
  25.     On Error Resume Next
  26.     Set XmlDoc = CreateObject("Microsoft.XMLDOM")
  27.     XmlDoc.async = "false"
  28.     XmlDoc.Load ("http://kaijiang.500.com/static/info/kaijiang/xml/" & ShengFen & "k3/" & Format(dDate, "yyyymmdd") & ".xml")
  29.         
  30.     Set oNodes = XmlDoc.DocumentElement.ChildNodes
  31.     If Err.Number > 0 Then
  32.         ReDim rsArr(1 To 1, 1 To 3)
  33.         GoTo TheEnd
  34.     End If
  35.    
  36.     ReDim rsArr(1 To oNodes.Length, 1 To 3)
  37.     For Each el In oNodes
  38.         k = k + 1
  39.         rsArr(k, 1) = el.Attributes(0).Text
  40.         rsArr(k, 2) = el.Attributes(2).Text
  41.         rsArr(k, 3) = el.Attributes(1).Text
  42.     Next
  43. TheEnd:
  44.     getDataFromWebByDate = rsArr
  45. End Function
复制代码

评分

1

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-12-3 14:33 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
duquancai 发表于 2018-12-3 13:10
用Python 和库pandas
把你的需求 在1到2分钟内 所有的数据及你需求一锅端了。

已遵照您的提醒,下载了Python 和库pandas,正在学习和熟练中。谢谢老师的热心帮忙!

TA的精华主题

TA的得分主题

发表于 2018-12-3 20:41 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
36楼的代码测试的时候发现有些时间段的网页格式不一样导致日期没读到。请把41-43行代码改成下面的:
  1.         rsArr(k, 1) = el.Attributes.getNamedItem("expect").NodeValue
  2.         rsArr(k, 2) = el.Attributes.getNamedItem("opentime").NodeValue
  3.         rsArr(k, 3) = el.Attributes.getNamedItem("opencode").NodeValue
复制代码

TA的精华主题

TA的得分主题

发表于 2018-12-3 21:21 | 显示全部楼层
WYS67 发表于 2018-12-3 14:33
已遵照您的提醒,下载了Python 和库pandas,正在学习和熟练中。谢谢老师的热心帮忙!

只有python和pandas是不够的。

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-12-13 07:50 | 显示全部楼层

江苏快三.png 重庆时时彩.png

老师:如上面截图所示,重庆时时彩和江苏快三格式基本相同【只是网址有别】,为什么下载重庆时时彩时发生如下所示的错误?
20181213074758.png 20181213074824.png

    重庆时时彩网页抓取数据.zip (200.42 KB, 下载次数: 6)
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

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

GMT+8, 2024-3-29 19:20 , Processed in 0.074311 second(s), 12 queries , Gzip On, Redis On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

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

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

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