VBA с CreateObject ("msxml2.xmlhttp") - получение данных из таблицы с нерегулярной структурой

Question

Я в возрасте 5 лет тратил часы, пытаясь решить эту проблему, и часами пытался понять это, вот так:)

Я пытаюсь извлечь некоторые таблицы из этой страницы компаниина Market Screener с использованием метода CreateObject.

Взяв в качестве примера таблицу (25) (этот) ( снимок экрана , я пытаюсь извлечь таблицу "Тип бизнеса"и в первом столбце перечислены типы бизнеса (не столбцы 2016, 2017 и Delta).

Я нашел главный старт в этом потоке 2016 stackoverflow

    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

Это вроде работает, но возвращает беспорядочную таблицу со всеми данными в ней в одной ячейке, вот так, но перемешалось в одну ячейку

Затем я нашел другой твикон-лайн, который предлагает следующее: это позволяет копировать и вставлять, и позволить 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)

Что создает этот результат своего родаправильно, но не только значения - яЯ пытаюсь вставить специальное, без какого-либо форматирования.

Я немного схожу с ума и понимаю концепцию, но на данный момент полностью застрял.Есть ли способ сделать это?Я могу скопировать его на таблицы на этой странице и на другие вкладки, если у меня есть преимущество.

Любая помощь с благодарностью,

С наилучшими пожеланиями, Пол

Answer 1

Если у вас Excel 2010+, вы можете сделать это с помощью Power Query. Вы можете настроить запрос для получения этих данных из Интернета.

Код 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 таблиц, если я правильно помню.

Answer 2

Используя данный пример, вы можете использовать комбинацию класса и типа (тега) для выбора этих элементов. Та же логика применима и к следующей таблице. Проблема здесь в том, что вам действительно нужно проверить 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