我已经花了5个小时试图解决这个问题,花了几个小时试图理解它,所以这里有:)
我试图使用CreateObject方法从this company page on Market Screener中提取一些表。
以表(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排序,但不仅仅是值 - 我试图粘贴特殊,没有任何格式。
让我有点疯狂并获得概念,但此刻完全停滞不前。有办法吗?我可以在该页面上的表格和其他标签上复制它,如果我有一个良好的开端。
任何帮助非常感谢,
最诚挚的问候,保罗
如果您使用的是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个表。
以您给出的示例为例,您可以使用类和类型(标记)的组合来选择这些元素。同样的逻辑也适用于下一个表。这里的问题是你真的必须检查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