从不显示表格的第一列的网页获取表格数据

我需要从这个页面取价格表： http : //www.kieskeurig.nl/objectief/canon/ef_100mm_f2_usm/prijzen/bezorgen/167557#prijzen

到目前为止，我已经开发了这个代码来获取数据

Sub TableExample() Dim IE As Object Dim doc As Object Dim strURL As String strURL = "http://www.kieskeurig.nl/objectief/canon/ef_100mm_f2_usm/prijzen/bezorgen/167557#prijzen" ' replace with URL of your choice Set IE = CreateObject("InternetExplorer.Application") With IE '.Visible = True .navigate strURL Do Until .readyState = 4: DoEvents: Loop Do While .Busy: DoEvents: Loop Set doc = IE.document GetAllTables doc .Quit End With End Sub Sub GetAllTables(doc As Object) ' get all the tables from a webpage document, doc, and put them in a new worksheet Dim ws As Worksheet Dim rng As Range Dim tbl As Object Dim rw As Object Dim cl As Object Dim tabno As Long Dim nextrow As Long Dim I As Long Set ws = Sheets("Sheet1") For Each tbl In doc.getElementsByTagName("TABLE") tabno = tabno + 1 nextrow = nextrow + 1 Set rng = ws.Range("B" & nextrow) rng.Offset(, -1) = "Table " & tabno For Each rw In tbl.Rows For Each cl In rw.Cells rng.Value = cl.innerText Set rng = rng.Offset(, 1) I = I + 1 Next cl nextrow = nextrow + 1 Set rng = rng.Offset(1, -I) I = 0 Next rw Next tbl ws.Cells.ClearFormats End Sub 

这个代码确实对我有效

但问题是第一列，即供应商数据不显示在获取的表中。

任何人都可以请帮助我

Answer 1

将您的GetAllTables子例程replace为以下内容：

 Sub GetAllTables(doc As Object) ' get all the tables from a webpage document, doc, and put them in a new worksheet Dim ws As Worksheet Dim rng As Range Dim tbl As Object Dim rw As Object Dim cl As Object Dim tabno As Long Dim nextrow As Long Dim I As Long Set ws = Sheets("Sheet1") For Each tbl In doc.getElementsByTagName("TABLE") tabno = tabno + 1 nextrow = nextrow + 1 Set rng = ws.Range("B" & nextrow) rng.Offset(, -1) = "Table " & tabno For Each rw In tbl.Rows colno = 1 For Each cl In rw.Cells If colno = 1 and nextrow > 1 then Set classColl = doc.getElementsByClassName("shopLogoX") Set imgTgt = classColl(nextrow - 2).getElementsByTagName("img") rng.Value = imgTgt(0).getAttribute("alt") Else rng.Value = cl.innerText End If Set rng = rng.Offset(, 1) I = I + 1 colno = colno + 1 Next cl nextrow = nextrow + 1 Set rng = rng.Offset(1, -I) I = 0 Next rw Next tbl ws.Cells.ClearFormats End Sub 

事实上，这个变化是非常小的。 我们使用colno来跟踪我们已经在行中的哪一列。 显然，我们检查是否在第一个单元格中。 如果我们在第一列而不在第一行（标题行）上，我们创build一个类shopLogoX的元素的集合。 这包含具有我们想要的alt属性的img标签。

尝试，testing和工作。 让我们知道这是否有帮助。