问题描述
如何从网页中提取Excel中的下表?
How to Extract Below table in Excel from Webpage?
表
公司|奖金比率|公告|记录|前奖金
Company | Bonus Ratio |Announcement|Record|Ex-Bonus
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中复制时,奖金比率转换为小数
by Keeping Bonus Ratio as Same as on Webpage or Text FormatWhile copy it in Excel, Bonus Ratio Converts to Decimal
推荐答案
您的hTable是一个集合,而不是单个元素.您的代码应该抛出错误.
Your hTable is a collection as opposed to a single element. Your code should be throwing an error.
您要定位到特定的表,然后循环表中的行和行中的单元格.您要检查是否正在处理第二列,以便可以保护比率的格式.您还希望监视行号以处理顶部的合并单元格.
You want to target the specific table and then loop the table rows and cells within rows. You want to check if the second column is being processed so you can protect the formatting of the ratios. You also want to monitor the row number to handle the merged cells at the top.
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
这篇关于使用VBA从Excel中的网页提取表的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持!