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

WYS67

mzbao 发表于 2018-12-3 08:43

嗯，这次完全实现了我心中所想！只是为什么《江苏快三》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   啊!

mzbao

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

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

mzbao

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. 
   
10.     ReDim rsArr(1 To UBound(arr), 1 To 3)
    
11.     For i = 1 To UBound(arr)
    
12.         brr = Split(arr(i), "|")
    
13.         rsArr(i, 1) = brr(1)
    
14.         If InStr(brr(3), "type") Then
    
15.             brr(3) = Left(brr(3), InStr(brr(3), """ type") - 1)
    
16.         End If
    
17.         rsArr(i, 2) = brr(3)
    
18.         rsArr(i, 3) = brr(2)
    
19.     Next

复制代码

WYS67

mzbao 发表于 2018-12-3 10:26
你可以把37-51行代码，替换成下面的代码，可以去掉以前网页里的除日期外的内容：

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

duquancai

WYS67 发表于 2018-12-3 11:17
可以把37-51行代码，替换成下面的代码后，B:C列仍然显示其它内容：

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

mzbao

给你换一个方法，这个应该不会出现其它字符了。

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. 
    
11.     StDate = Format("20" & Left([B2].Value, 6), "0000/00/00")
    
12.     EndDate = Format("20" & Left([B3].Value, 6), "0000/00/00")
    
13.    
    
14.     tempDate = EndDate
    
15.     Do
    
16.         rsArr = getDataFromWebByDate(tempDate, ShengFen)
    
17.         Range("A" & Cells(Rows.Count, 1).End(xlUp).Row + 1).Resize(UBound(rsArr), 3) = rsArr
    
18.         tempDate = tempDate - 1
    
19.     Loop Until tempDate < StDate
    
20.    
    
21. End Sub
    
22. 
    
23. Function getDataFromWebByDate(dDate As Date, ShengFen As String)
    
24.     Dim XmlDoc As Object, oNodes As Object, el, k%
    
25.     Dim rsArr()
    
26.    
    
27.     On Error Resume Next
    
28.     Set XmlDoc = CreateObject("Microsoft.XMLDOM")
    
29.     XmlDoc.async = "false"
    
30.     XmlDoc.Load ("http://kaijiang.500.com/static/info/kaijiang/xml/" & ShengFen & "k3/" & Format(dDate, "yyyymmdd") & ".xml")
    
31.         
    
32.     Set oNodes = XmlDoc.DocumentElement.ChildNodes
    
33.     If Err.Number > 0 Then
    
34.         ReDim rsArr(1 To 1, 1 To 3)
    
35.         GoTo TheEnd
    
36.     End If
    
37.    
    
38.     ReDim rsArr(1 To oNodes.Length, 1 To 3)
    
39.     For Each el In oNodes
    
40.         k = k + 1
    
41.         rsArr(k, 1) = el.Attributes(0).Text
    
42.         rsArr(k, 2) = el.Attributes(2).Text
    
43.         rsArr(k, 3) = el.Attributes(1).Text
    
44.     Next
    
45. TheEnd:
    
46.     getDataFromWebByDate = rsArr
    
47. End Function

复制代码

WYS67

duquancai 发表于 2018-12-3 13:10
用Python 和库pandas
把你的需求 在1到2分钟内 所有的数据及你需求一锅端了。

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

mzbao

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
   

复制代码

chentonny

WYS67 发表于 2018-12-3 14:33
已遵照您的提醒，下载了Python 和库pandas，正在学习和熟练中。谢谢老师的热心帮忙！

只有python和pandas是不够的。

WYS67

mzbao 发表于 2018-12-3 08:43

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


    重庆时时彩网页抓取数据.zip (200.42 KB, 下载次数: 6)

2018-12-13 07:50 上传

点击文件名下载附件