如何从宏中将数据从多个网页提取到Excel中 [英] How to extract data from multiple webpages into Excel with a macro
问题描述
我正在尝试从一个特定网站将数据提取到Excel(2007),但分布在多个网页上。我想在表格中看到哪些项目是在这个网站上提供的,没有经过很多页面或使用搜索(在我的浏览器中有点儿bug)。
I'm trying to extract data into Excel (2007) from one specific website, but spread over multiple webpages. What I want to see in my sheet is which items are offered on this website, without going through many pages or using the search (it's a bit buggy in my browser).
我已经尝试通过Excel导入数据,但只适用于一个页面。因为数据覆盖了183页,我必须做183次才能完成。
I have tried importing the data via Excel, but that only works for one page. Because the data is covered over 183 pages, I must do it 183 times to complete.
我的猜测是,使用宏可以更快地工作,但是我没有经验接着就,随即。
我在这个论坛上进行了搜索,但是我确实发现这个宏会给出一个错误,或是仅为一个页面进行了工作。
My guess is that it will work faster with a macro, but I have no experience with that. I did a search on this forum, but al the macro's I did find would either give an error or did the work for one page only.
链接到相关网站是 http://www.scalemodelstore.nl /modellen/2/Vliegtuigen.html?&pageID=0
链接中唯一的变化是结束:pageID = 1,2,等等。
The only change in the link is at the end: pageID=1, 2, and so on.
提前感谢
推荐答案
一个:
Sub GetData()
Dim lRow, lPage, oXmlHttp, sResp, aResp, sPart, oHtmlFile, oBody, sInText, aInLines, lCol, sLineText, aImgPts
lRow = 1
lPage = 0
Do
sUrl = "http://www.scalemodelstore.nl/modellen/2/Vliegtuigen.html?&pageID=" & lPage
Do
Set oXmlHttp = CreateObject("MSXML2.XMLHttp")
oXmlHttp.Open "GET", sUrl, True
oXmlHttp.Send
Do Until oXmlHttp.ReadyState = 4
DoEvents
Loop
sResp = oXmlHttp.ResponseText
Loop While sResp = ""
aResp = Split(sResp, "<a class=""productTile"" ")
For i = 1 To UBound(aResp)
sPart = "<a " & aResp(i)
sPart = Split(sPart, "</a>")(0)
Set oHtmlFile = CreateObject("htmlfile")
oHtmlFile.Write sPart
Set oBody = oHtmlFile.GetElementsByTagName("body")(0)
sInText = Trim(oBody.InnerText)
aInLines = Split(sInText, vbCrLf)
lCol = 1
For Each sLineText In aInLines
sLineText = Trim(sLineText)
If sLineText <> "" Then
Cells(lRow, lCol).Value = sLineText
lCol = lCol + 1
End If
Next
aImgPts = Split(sPart, "<img src=""")
If UBound(aImgPts) > 0 Then
Cells(lRow, lCol).Value = Split(aImgPts(1), """")(0)
End If
lRow = lRow + 1
Next
lPage = lPage + 1
Loop Until UBound(aResp) = 0
End Sub
此代码只为所有网页上的每个模型获取所有可用数据,并将其放入工作表中,每个模型一行。请注意,它不是一站式解决方案,代码现在可以工作,但一旦网站内容发生变化,可能会出现错误。
This code just gets all available data for each model on all webpages and put it into worksheet, one row for each model. Note, it is not a one-stop solution, the code works now, but may become faulty as soon as the website content changed.
这篇关于如何从宏中将数据从多个网页提取到Excel中的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!