使用VBA for Excel使用数组获取HTML表格内容



试图从该网站的第二个表中获取数据,因为第一个表只包含下拉列表的元素,无论出于何种原因,它都作为一个表包含在HTML中!

该代码引用了一个类似的页面,但是,在该页面中,第一个表不存在,在那里它工作得很好,只是不在具有两个不同内容的表的页面上。

因此,我们的想法是使用下面的代码,但首先要跳过第一个表,只提取第二个表(tr/td(中与给定数组中元素匹配的内容。

有人知道如何修改代码来处理这个问题吗?谢谢

包含两个表的代码段(运行代码段以查看下拉列表(:

<table border="1">
<tbody>
<tr>
<td>
<select size="1" onchange="nextpage(this.options[this.selectedIndex].value,'-1','-1')">
<option value="1-1-11">1-2</option>
<option value="all" selected="selected">all</option>
</select>
</td>
<td></td>
</tr>
</tbody>
</table>
<table border="0">   
<tbody>
<tr>
<td>valign=“top“ aling“left“>
<nobr>Description</nobr></td>

包含功能的代码段

Dim table As MSHTML.HTMLTable, R As Long, c As Long, headers(), row As MSHTML.HTMLTableRow
Dim results() As Variant, html2 As MSHTML.HTMLDocument
headers = Array("HDR01", " HDR02", " HDR03", " HDR04")
ReDim results(1 To 100, 1 To UBound(headers) + 1)
Set table = html.querySelector("table")
Set html2 = New MSHTML.HTMLDocument
Dim lastRow As Boolean

For Each row In table.Rows
Dim header As String
lastRow = False
html2.body.innerHTML = row.innerHTML
header = Trim$(row.Children(0).innerText)        
If header = "Description" Then          
R = R + 1
Dim dict As Scripting.Dictionary: Set dict = GetBlankDictionary(headers)
End If
If dict.Exists(header) Then 
dict(header) = Trim$(row.Children(1).innerText)       
End If        
....
If lastRow Then
populateArrayFromDict dict, results, R
End If
Next

With ActiveSheet
.Cells(1, 1).Resize(1, UBound(headers) + 1) = headers
.Cells(2, 1).Resize(UBound(results, 1), UBound(results, 2)) = results
End With

功能:

Public Function GetBlankDictionary(ByRef headers() As Variant) As Scripting.Dictionary
Dim dict As Scripting.Dictionary, i As Long
Set dict = New Scripting.Dictionary
For i = LBound(headers) To UBound(headers)
dict(headers(i)) = vbNullString
Next
Set GetBlankDictionary = dict
End Function

我需要这样的东西,工作:

If table.Border = "1" Then   'with Droplist
Set table = html.querySelectorAll("body").Item(1)   'skip table0
ElseIf table.Border = "0" Then  'wihtout Droplist
Set table = html.querySelectorAll("body").Item(0)   'start with this table
End If

将正确的属性和值添加到选择器以获得正确的表

Set table = html.querySelector("table[border='0']")

最新更新