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

Question

试图从本网站的 第二个 table 获取数据，因为第一个 table 仅包含下拉列表的元素，无论出于何种原因这作为 table 包含在 HTML!

中

该代码引用了一个类似的页面，但是其中第一个 table 不存在，它工作正常，只是不在具有不同内容的两个 table 的页面上.

所以想法是使用下面的代码，但首先要跳过第一个table并仅提取第二个table的内容（ tr/td) 匹配给定数组中的元素。

有谁知道必须如何修改代码才能处理此问题？谢谢！

包含两个 table 的代码段（运行查看下拉列表的代码段）：

<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

Answer 1

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

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

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

Get HTML Table content with VBA for Excel using arrays

arrays

excel

vba

html-table

web-scraping