如何从网页中提取Excel中的下表?
表
公司|奖金比率|公告|记录|前奖金
Codes
Dim ie As SHDocVw.InternetExplorer
Set ie = New InternetExplorerMedium
Set ie = CreateObject("InternetExplorer.Application")
While ie.busy
DoEvents
Wend
ie.Visible = True
While ie.busy
DoEvents
Wend
Dim NavURL As String
NavURL = "https://www.moneycontrol.com/stocks/marketinfo/bonus/homebody.php?sel_year=2015"
ie.Navigate NavURL
While ie.busy
DoEvents
Wend
Set doc = ie.document
Set hTable = doc.GetElementsByTagName("table")
y = 2 'Column B in Excel
z = 7 'Row 7 in Excel
For Each td In hTable
Set hHead = tb.GetElementsByTagName("td")
For Each hh In hHead
Set hTR = hh.GetElementsByTagName("tr")
For Each tr In hTR
网页:https://www.moneycontrol.com/stocks/marketinfo/bonus/homebody.php?sel_year=2015
通过保持奖金比率与网页或文本格式相同 在Excel中复制时,奖金比率转换为小数
答案 0 :(得分:0)
您的hTable是一个集合,而不是单个元素。您的代码应该抛出错误。
您要定位到特定表,然后循环表中的行和行内的单元格。您要检查是否正在处理第二列,以便可以保护比率的格式。您还希望监视行号以处理顶部的合并单元格。
Option Explicit
Public Sub GetInfo()
Const URL As String = "https://www.moneycontrol.com/stocks/marketinfo/bonus/homebody.php?sel_year=2015"
Dim html As HTMLDocument, hTable As HTMLTable, ws As Worksheet, headers()
headers = Array("Company", "Bonus Ratio", "Announcement", "Record", "Ex-bonus")
Set ws = ThisWorkbook.Worksheets("Sheet1")
Set html = New HTMLDocument
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", URL, False
.Send
html.body.innerHTML = .responseText
End With
Set hTable = html.querySelector("table.dvdtbl")
Dim td As Object, tr As Object, r As Long, c As Long
r = 1
With ws
.Cells(1, 1).Resize(1, UBound(headers) + 1) = headers
For Each tr In hTable.getElementsByTagName("tr")
r = r + 1: c = 1
If r > 3 Then
For Each td In tr.getElementsByTagName("td")
.Cells(r - 2, c) = IIf(c = 2, "'" & td.innerText, td.innerText)
c = c + 1
Next
End If
Next
End With
End Sub