Извлечение таблицы из веб-страницы в Excel с использованием VBA

Question

Как извлечь приведенную ниже таблицу в Excel с веб-страницы?

Таблица

Компания |Бонусное соотношение | Объявление | Запись | 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, Bonus RatioПреобразует в десятичную

Answer 1

Ваш 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