具有CreateObject（“ msxml2.xmlhttp”）的VBA-从具有不规则结构的表中获取数据

Question

我已经5岁了，花了数小时试图解决这个问题，花了数小时试图理解它，所以去了：）

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

以表（25）为例（此）（screenshot，我试图提取表“业务类型”，第一列列出业务类型（不是2016、2017和Delta）列）。

我在此找到了先机 2016 stackoverflow thread

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)

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

中

然后我在网上发现了另一个调整，它是建议复制和粘贴，并让Excel确定如何粘贴它，以及哪种工作方式：

words = ['foo','bar']
s = [[c1 for c1 in word] for word in words]
print(s)

哪个可以正确创建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