使用VBA从Excel中的网页提取表 [英] Extract Table from Webpage in Excel using VBA

问题描述

如何从网页中提取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 Format While 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中的网页提取表的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！