首页
学习
活动
专区
工具
TVP
发布
社区首页 >问答首页 >VBA With CreateObject("msxml2.xmlhttp") -从结构不规则的表中获取数据

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

Stack Overflow用户
提问于 2019-03-17 02:01:05
回答 2查看 1.9K关注 0票数 1

我花了5年的时间试图解决这个问题,花了很多时间试图理解它,所以这里是这样的:)

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

以表(25)为例(此表) (screenshot,我尝试提取表“业务类型”,第一列列出业务类型(不是2016、2017和Delta列)。

我在这个2016 stackoverflow thread里找到了一个在线头条

代码语言:javascript
复制
    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自己决定如何粘贴它,这也是一种可行的方法:

代码语言:javascript
复制
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排序,但不仅仅是值-我正在尝试粘贴特殊的,没有任何格式。

这让我有点抓狂,并理解了这个概念,但现在完全被困住了。有办法做到这一点吗?我可以将其复制到该页面的表格和其他选项卡上,然后如果我有领先优势的话。

任何帮助都非常感谢,

致以最好的问候,保罗

EN

Stack Overflow用户

发布于 2019-03-17 02:38:37

以给定的示例为例,您可以使用类和类型(标记)的组合来选择这些元素。同样的逻辑也适用于下一个表。这里的问题是,你真的必须检查html并定制你所做的事情。否则,您不想要的简单解决方案是使用剪贴板。

代码语言:javascript
复制
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
票数 0
EN
查看全部 2 条回答
页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接:

https://stackoverflow.com/questions/55199898

复制
相关文章

相似问题

领券
问题归档专栏文章快讯文章归档关键词归档开发者手册归档开发者手册 Section 归档