VBA With CreateObject("msxml2.xmlhttp") - 从不规则结构的表中获取数据

Question

我已经 5 岁了，花了好几个小时试图解决这个问题，并花了好几个小时试图理解它，所以这里是 :)

我正在尝试从中提取一些表 this company page on Market Screener 使用 CreateObject 方法。

以表（25）为例（这个）（screenshot，我正在尝试提取表“业务类型”，第一列列出了业务类型（不是 2016、2017 和 Delta 列） .

我在这个网站上找到了一个领先的在线 2016 stackoverflow thread

    Dim oDom As Object: Set oDom = CreateObject("htmlFile")
Dim x As Long, y As Long
Dim oRow As Object, oCell As Object
Dim vData As Variant
Dim link As String

link = "https://www.marketscreener.com/COLUMBIA-SPORTSWEAR-COMPA-8859/company/"

y = 1: x = 1

With CreateObject("msxml2.xmlhttp")
    .Open "GET", link, False
    .send
    oDom.body.innerHTML = .responseText
End With

With oDom.getElementsByTagName("table")(25)
    ReDim vData(1 To .Rows.Length, 1 To 11) '.Rows(1).Cells.Length)
    For Each oRow In .Rows
        For Each oCell In oRow.Cells
            vData(x, y) = oCell.innerText
            y = y + 1
        Next oCell
       y = 1
        x = x + 1
    Next oRow
End With


Sheets(2).Cells(66, 2).Resize(UBound(vData), UBound(vData, 2)).Value = vData

它有点工作，但返回一个混乱的表格，其中所有数据都在一个单元格中，like this, but jumbled into a single cell

然后我在网上找到了另一个调整，就是这个，它建议复制和粘贴，让 Excel 计算出如何粘贴，这也可以：

With oDom.getElementsByTagName("table")(25)
    Dim dataObj As Object
    Set dataObj = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
    dataObj.SetText "<table>" & .innerHTML & "</table>"
    dataObj.PutInClipboard
End With

Sheets(2).Paste Sheets(2).Cells(66, 1)

这会正确创建 this result 排序，但不仅仅是值 - 我正在尝试粘贴特殊的，没有任何格式。

让我有点发疯并理解了这个概念，但现在完全卡住了。有没有办法做到这一点？我可以在该页面上的表格和其他选项卡上复制它，然后如果我有一个先机的话。

非常感谢任何帮助，

最好的问候， 保罗

Answer 1

如果您有 Excel 2010+，则可以使用 Power Query 执行此操作。 您可以设置查询以从 Web 获取此数据。

PQ 代码为：

let
    Source = Web.Page(Web.Contents("https://www.marketscreener.com/COLUMBIA-SPORTSWEAR-COMPA-8859/company/")),
    myData = Source{3}[Data],
    firstColumn = {List.First(Table.ColumnNames(myData))},
    #"Removed Other Columns" = Table.SelectColumns(myData,firstColumn),
    #"Removed Blank Rows" = Table.SelectRows(#"Removed Other Columns", each not List.IsEmpty(List.RemoveMatchingItems(Record.FieldValues(_), {"", null})))
in
    #"Removed Blank Rows"

这会导致：

并且查询可以刷新、编辑等。

正如所写，查询将保留所需表的第一列。您可以通过更改Source{n} 中的数字来决定要处理哪个表。 3 恰好是您感兴趣的那个，但如果我没记错的话，有 11 或 12 张桌子。

Answer 2

以您给定的示例为例，您可以使用类和类型（标签）的组合来选择这些元素。同样的逻辑也适用于下一张表。这里的问题是你真的必须检查 html 并调整你的工作。否则，您不想要的简单解决方案是使用剪贴板。

Option Explicit   
Public Sub GetTableInfo()
    Dim html As HTMLDocument
    Set html = New HTMLDocument                  '<  VBE > Tools > References > Microsoft Scripting Runtime
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", "https://www.marketscreener.com/COLUMBIA-SPORTSWEAR-COMPA-8859/company/", False
        .send
        html.body.innerHTML = .responseText
    End With
    Dim leftElements As Object, td As Object
    '.tabElemNoBor.fvtDiv tr:nth-of-type(2) td.nfvtTitleLeft
    Set leftElements = html.getElementsByClassName("tabElemNoBor fvtDiv")(0).getElementsByTagName("tr")(2)
    For Each td In leftElements.getElementsByTagName("td")
        If td.className = "nfvtTitleLeft" Then
            Debug.Print td.innerText
        End If
    Next
End Sub