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

WYS67

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

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

麻烦老师用新附件 按B1指定的网址和B2B3指定的期号下载开奖数据.zip (15.95 KB, 下载次数: 3)

2018-12-2 09:32 上传

点击文件名下载附件

作个范例上传。里面的两个工作表是《江苏快三》和《安徽快三》，要求按B1指定的网址，B2:B3指定的起止期号，分别下载对应的历史开奖数据。

WYS67

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

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

Kaohsing

这是python不是vba。

WYS67

Kaohsing 发表于 2018-12-2 12:23
这是python不是vba。

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

mzbao

开奖详情的数据地址：http://kaijiang.500.com/static/i ... l/jsk3/20181201.xml
你可以根据根据更改地址，然后读取。

Kaohsing

WYS67 发表于 2018-12-2 12:35
怎么运行？代码复制粘贴到哪里？

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

WYS67

Kaohsing 发表于 2018-12-2 13:47
下载Python。在下载一些库，在下个idle，黏贴到idle

这么复杂啊？从未用过啊？！

mzbao

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. 
    
19. Function getDataFromWebByDate(dDate As Date)
    
20.     Dim strText As String, arr, brr, rsArr(), i%, j%
    
21.    
    
22.     With CreateObject("MSXML2.XMLHTTP")
    
23.         .Open "GET", "http://kaijiang.500.com/static/info/kaijiang/xml/jsk3/" & Format(dDate, "yyyymmdd") & ".xml", False
    
24.         .Send
    
25.         strText = .responsetext
    
26.     End With
    
27.    
    
28.     If InStr(strText, "404 Not Found") Then
    
29.         ReDim rsArr(1 To 1, 1 To 3)
    
30.         GoTo TheEnd
    
31.     End If
    
32.    
    
33.     strText = Replace(strText, " expect=""", "|")
    
34.     strText = Replace(strText, """ opencode=""", "|")
    
35.     strText = Replace(strText, """ opentime=""", "|")
    
36.     strText = Replace(strText, Chr(10), "")
    
37.     strText = Replace(strText, """               />", "")
    
38.    
    
39.     arr = Split(strText, "<row")
    
40. 
    
41.     ReDim rsArr(1 To UBound(arr), 1 To 3)
    
42.     For i = 1 To UBound(arr)
    
43.         brr = Split(arr(i), "|")
    
44.         rsArr(i, 1) = brr(1)
    
45.         rsArr(i, 2) = brr(3)
    
46.         rsArr(i, 3) = brr(2)
    
47.     Next
    
48. TheEnd:
    
49.     getDataFromWebByDate = rsArr
    
50. End Function

复制代码

Kaohsing

WYS67 发表于 2018-12-2 14:17
这么复杂啊？从未用过啊？！

比中彩票，容易一点。

WYS67

mzbao 发表于 2018-12-2 14:29

老师编写的代码很好！以最新附件只需修改21楼描述的几处，就能圆满实现我的心中所想：