怎么取网页表格上的60000多条数据到EXCEL上？

Kil1

http://szsbzx.jsszhrss.gov.cn:9900/web/website/pubQuery/ypmlQuery.jsp

duquancai

6W多条，太多了，能不能少点呢？

Kil1

duquancai 发表于 2018-8-19 18:42
6W多条，太多了，能不能少点呢？

取2页、3页均可，要个方法！

duquancai

Kil1 发表于 2018-8-19 20:25
取2页、3页均可，要个方法！

我没得方法，怎么给你呢？等后面的大神吧！

hau耗子

用码栈，不到十分钟就能采集到数据，https://codestore.taobao.com/index.htm

duquancai

Kil1 发表于 2018-8-19 20:25
取2页、3页均可，要个方法！

1. Sub main()
   
2.     Dim xmlHttp As Object, DOM As Object, strText$, p&, arrData(1 To 70000, 1 To 16), i&, j&, n&
   
3.     Set xmlHttp = CreateObject("msxml2.xmlhttp")
   
4.     Set DOM = CreateObject("htmlfile")
   
5.     For p = 1 To 3 '只搞第3页,共60条数据,别抓多了,够意思就行了！
   
6.         With xmlHttp
   
7.             .Open "POST", "http://szsbzx.jsszhrss.gov.cn:9900/web/website/pubQuery/pubQueryAction?frameControlSubmitFunction=getPagesAjax", False
   
8.             .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
   
9.             .send "querytype=ypml&pageIndex=" & p & "&pageCount=20&sfzf=1"
   
10.             strText = .responsetext
    
11.         End With
    
12.         With DOM
    
13.             .body.innerhtml = strText
    
14.             For i = IIf(p = 1, 0, 1) To .all.tags("table")(1).Rows.Length - 1
    
15.                 n = n + 1
    
16.                 For j = 0 To .all.tags("table")(1).Rows(i).Cells.Length - 1
    
17.                     arrData(n, j + 1) = Split(.all.tags("table")(1).Rows(i).Cells(j).innerText, "<\/td>")(0)
    
18.                 Next
    
19.             Next
    
20.         End With
    
21.     Next
    
22.     Cells.Clear
    
23.     Range("a1").Resize(n, 16) = arrData
    
24. End Sub

复制代码

huang1314wei

1. Sub GetData()
   
2.     Dim strData$
   
3.     Application.ScreenUpdating = False
   
4.     Cells.Clear
   
5.     With CreateObject("Forms.TextBox.1")
   
6.         For i = 1 To 3
   
7.             strData = TableStr(i)
   
8.             .Text = strData
   
9.             .SelStart = 0
   
10.             .SelLength = Len(strData)
    
11.             .Copy
    
12.             If i = 1 Then
    
13.                 Range("A1").Select
    
14.             Else
    
15.                 Range("A65536").End(xlUp).Offset(1).Select
    
16.             End If
    
17.             ActiveSheet.PasteSpecial
    
18.         Next
    
19.     End With
    
20.     Application.ScreenUpdating = True
    
21. End Sub
    
22. 
    
23. 
    
24. Function TableStr(ByVal PageIndex As Integer) As String
    
25.     Dim Url$, PostData$
    
26.     PostData = "querytype=ypml&pageIndex=" & PageIndex & "&pageCount=20&sfcf=&tym=&spm=&sfzf=1"
    
27.     Url = "http://szsbzx.jsszhrss.gov.cn:9900/web/website/pubQuery/pubQueryAction?frameControlSubmitFunction=getPagesAjax"
    
28.     With CreateObject("MsXml2.Xmlhttp")
    
29.         .Open "Post", Url, False
    
30.         .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    
31.         .setRequestHeader "Connection", "keep-alive"
    
32.         .send (PostData)
    
33.         strreponsetext = .responsetext
    
34.         TableStr = Replace("<table" & Split(Split(strreponsetext, "<table")(2), "<\/table>")(0) & "<\/table>", "\t", "")
    
35.     End With
    
36. End Function
    

复制代码

huang1314wei

附件参考>>>>>>>>>>>>>>

获取网页数据.rar (17.45 KB, 下载次数: 78)

2018-8-19 23:10 上传

点击文件名下载附件

fxl447098457

hau耗子 发表于 2018-8-19 20:55
用码栈，不到十分钟就能采集到数据，https://codestore.taobao.com/index.htm

好哈，大佬，捉到你了，M群里的。耗子哥

我是来讨说法的

用python采集，也就半个小时的事情的，需要联系我