多个网页的数据批量提取

残缺的基督

各位论坛的大大，萌新有一个需求，希望各位大大能够指条明路。我的附件有3个sheet，分别是URL，数据表，数据自网站下载的内容。其中URL 是列表就是我需求爬取的网页链接，数据表是我希望最终汇总数据的表格，“数据自网站下载的内容”是我使用EXCEL 自带从网站提取数据提取到的内容，标黄的部分就是数据表要提取的内容。现在我希望能够有一个宏，批量完成此项工作，就不用操作400多次。麻烦各位大大指导，或者能给一个类似的代码我自行修改，万分感谢。

onlycxb

直接从http://gs.amac.org.cn/amac-infodisc/res/pof/manager/index.html取得数据列表，再利用程序逐个抓取各数据项。人为操作可一次完成，但程序终究还是逐个获取的

残缺的基督

onlycxb 发表于 2020-1-6 13:26
直接从http://gs.amac.org.cn/amac-infodisc/res/pof/manager/index.html取得数据列表，再利用程序逐个抓取 ...

谢谢您 我也再研究一下，论坛里面有我这样类似的需求，我读了一些代码太复杂了。

wbperfect

1. Sub getifo()
   
2. Dim str As String
   
3. Dim t
   
4. t = Timer
   
5. For m = 2 To Sheets("URL").Range("A1048576").End(xlUp).Row
   
6. URL = Sheets("URL").Cells(m, 1)
   
7. With CreateObject("internetexplorer.application")
   
8. .Navigate URL
   
9. While .busy Or .readystate <> 4: Wend
   
10. On Error Resume Next
    
11. Sheets("数据表").Cells(m, "A") = .Document.getElementsByTagName("TD")(2405).innertext
    
12. Sheets("数据表").Cells(m, "B") = .Document.getElementsByTagName("TD")(2407).innertext
    
13. Sheets("数据表").Cells(m, "C") = .Document.getElementsByTagName("TD")(2409).innertext
    
14. Sheets("数据表").Cells(m, "D") = .Document.getElementsByTagName("TD")(2411).innertext
    
15. Sheets("数据表").Cells(m, "E") = .Document.getElementsByTagName("TD")(2413).innertext
    
16. Sheets("数据表").Cells(m, "F") = .Document.getElementsByTagName("TD")(2415).innertext
    
17. Sheets("数据表").Cells(m, "G") = .Document.getElementsByTagName("TD")(2417).innertext
    
18. Sheets("数据表").Cells(m, "H") = .Document.getElementsByTagName("TD")(2419).innertext
    
19. Sheets("数据表").Cells(m, "I") = .Document.getElementsByTagName("TD")(2421).innertext
    
20. Sheets("数据表").Cells(m, "J") = .Document.getElementsByTagName("TD")(2423).innertext
    
21. Sheets("数据表").Cells(m, "K") = .Document.getElementsByTagName("TD")(2425).innertext
    
22. Sheets("数据表").Cells(m, "L") = .Document.getElementsByTagName("TD")(2427).innertext
    
23. Sheets("数据表").Cells(m, "M") = .Document.getElementsByTagName("TD")(2429).innertext
    
24. Sheets("数据表").Cells(m, "N") = .Document.getElementsByTagName("TD")(2431).innertext
    
25. Sheets("数据表").Cells(m, "O") = .Document.getElementsByTagName("TD")(2433).innertext
    
26. Sheets("数据表").Cells(m, "P") = .Document.getElementsByTagName("TD")(2435).innertext
    
27. Sheets("数据表").Cells(m, "Q") = .Document.getElementsByTagName("TD")(2437).innertext
    
28. Sheets("数据表").Cells(m, "R") = .Document.getElementsByTagName("TD")(2439).innertext
    
29. 
    
30. 
    
31. .Quit
    
32. 
    
33. End With
    
34. 
    
35. Next
    
36. MsgBox "Complete!" & vbCrLf & "用时:" & " " & Timer - t & "秒"
    
37. End Sub
    

复制代码

IE大法试试  网页格式不太规律