Microsoft Excel 2010 Web查询macros：从一个拉多个页面
我正在寻找这个macrosfind一些帮助..这个想法是，执行后，macros将拉动网页的数据（IE浏览器http://www.link.com/id=7759 ），并把它放在让我们说Sheet2，然后打开第2页，然后将它放在页面1的页面2中的数据下面….等等，等等，直到设置页码..理想情况下，我只想拉下面的顺序;
标题艺术家types纸张大小图像大小零售奖金数量
而且更理想的是放置在4行和8行的适当的行和列中（如同网页中的列）。
任何帮助，将大大，非常感谢。 我做了一些研究，发现了类似的macros，很遗憾，没有运气让他们为我工作。 主要是VB也没有通过。
一些有用的信息（也许）当我试图写我自己的时候，我想到了这一点，也许这将节省谁曾经帮助过一段时间..
.WebTables = "8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38" 这些是我想要放入Que的每个项目的表
这里有一个示例方法，让你去
基于一些假设
-
工作簿包含一个工作表来保存查询数据称为“查询”
-
工作簿包含一张工作表，将数据放在名为“AllData”
-
运行macros时将删除所有旧数据
-
我认为你需要在qyuery中包含表7
-
要处理的页面被硬编码为
For Pg = 1 To 1，For Pg = 1 To 1更改为适合
。
Sub QueryWebSite() Dim shQuery As Worksheet, shAllData As Worksheet Dim clData As Range Dim qts As QueryTables Dim qt As QueryTable Dim Pg As Long, i As Long, n As Long, m As Long Dim vSrc As Variant, vDest() As Variant ' setup query Set shQuery = ActiveWorkbook.Sheets("Query") Set shAllData = ActiveWorkbook.Sheets("AllData") 'Set qt = shQuery.QueryTables(1) On Error Resume Next Set qt = shQuery.QueryTables("Liebermans") If Err.Number <> 0 Then Err.Clear Set qt = shQuery.QueryTables.Add( _ Connection:="URL;http://www.liebermans.net/productlist.aspx?id=7759&page=1", _ Destination:=shQuery.Cells(1, 1)) With qt .Name = "Liebermans" .WebSelectionType = xlSpecifiedTables .WebFormatting = xlWebFormattingNone .WebTables = "7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38" .WebPreFormattedTextToColumns = True .WebConsecutiveDelimitersAsOne = True .WebSingleBlockTextImport = False .WebDisableDateRecognition = False .WebDisableRedirections = False .Refresh BackgroundQuery:=False End With End If On Error GoTo 0 i = InStr(qt.Connection, "&page=") ' clear old data shAllData.UsedRange.ClearContents shAllData.Cells(1, 1) = "Title" shAllData.Cells(1, 2) = "Artist" shAllData.Cells(1, 3) = "Type" shAllData.Cells(1, 4) = "Paper Size" shAllData.Cells(1, 5) = "Image Size" shAllData.Cells(1, 6) = "Price" shAllData.Cells(1, 7) = "Quantity" m = 0 ReDim vDest(1 To 10000, 1 To 7) For Pg = 1 To 1 ' Query Wb site qt.Connection = Left(qt.Connection, i + 5) & Pg qt.Refresh False ' Process data vSrc = qt.ResultRange n = 2 Do While n < UBound(vSrc, 1) If vSrc(n, 1) <> "" And vSrc(n - 1, 1) = "" Then m = m + 1 vDest(m, 1) = vSrc(n, 1) End If If vSrc(n, 1) Like "Artist:*" Then vDest(m, 2) = Trim(Mid(vSrc(n, 1), 8)) If vSrc(n, 1) Like "Type:*" Then vDest(m, 3) = Trim(Mid(vSrc(n, 1), 6)) If vSrc(n, 1) Like "Paper Size:*" Then vDest(m, 4) = Trim(Mid(vSrc(n, 1), 12)) If vSrc(n, 1) Like "Image Size:*" Then vDest(m, 5) = Trim(Mid(vSrc(n, 1), 12)) If vSrc(n, 1) Like "Retail Price:*" Then vDest(m, 6) = Trim(Mid(vSrc(n, 1), 14)) If vSrc(n, 1) Like "Quantity in stock:*" Then vDest(m, 7) = Trim(Mid(vSrc(n, 1), 19)) n = n + 1 Loop Next ' Put data in sheet shAllData.Cells(2, 1).Resize(m, 7) = vDest End Sub