VBA webscraping, HTML-текст, чтобы преуспеть: Как извлечь дочерний элемент, игнорируя родительский элемент? - PullRequest
0 голосов
/ 08 ноября 2018

Я новичок и пытаюсь создать простой веб-шаблон из HTML-таблицы, чтобы преуспеть и борюсь с определенным дизайном веб-сайтов. Насколько я понимаю, большинство таблиц организованы с такими тегами: (table -> tr -> td) как in, table, row, затем cell.

Я могу справиться с этим достаточно просто, но у «основной таблицы», из которой я пытаюсь извлечь, есть таблицы и строки, содержащиеся в ячейке, например («главная таблица -> строка -> ячейка -> вложенная таблица -» > sub-row -> sub-cell). Для жизни я не могу получить чистый лист Excel

Вот как выглядит HTML:

подробный HTML

обзор HTML

Что мне нужно сделать, это извлечь только NCI и $392,764. Но пока я извлекаю дубликаты этих значений с помощью команды .innertext. Я надеюсь, что кто-то может помочь мне написать простой макрос, который получает только элемент lastchild из каждой родительской ячейки ... Спасибо!

Вот что у меня так далеко ...

Вот в чем проблема:

Sub processhtmlpage(htmlpage As mshtml.HTMLDocument)

Dim htmlTable As mshtml.IHTMLElement
Dim htmlTables As mshtml.IHTMLElementCollection
Dim HTMLRow As mshtml.IHTMLElement
Dim htmlrows As mshtml.IHTMLElementCollection
Dim htmlcell As mshtml.IHTMLElement
Dim rownum As Long, colnum As Integer


Set htmlTables = htmlpage.getElementsByTagName("table")
Set HTMLInnerTables = htmlpage.getElementsByTagName("table")
Set HTMLInnerRows = htmlpage.getElementsByTagName("tr")


    For Each htmlTable In htmlTables
        Worksheets.Add
        Range("a1").Value = htmlTable.className
        Range("b1").Value = Now
        rownum = 2
            For Each HTMLRow In htmlTable.getElementsByTagName("tr")
            colnum = 1
                For Each htmlcell In HTMLRow.getElementsByTagName("td")
                    Cells(rownum, colnum) = htmlcell.innerText
                    colnum = colnum + 1
                Next htmlcell
                rownum = rownum + 1
            Next HTMLRow
    Next htmlTable
End Sub

Я предпринял несколько безумных попыток обойти это, используя команды if ... then, но через несколько часов я просто потерян. Должен быть лучший способ. Пожалуйста помоги!!! В случае, если это полезно, вот группа ****, с которой я закончил:

Sub processhtmlpage(htmlpage As mshtml.HTMLDocument)

Dim htmlTable As mshtml.IHTMLElement
Dim htmlTables As mshtml.IHTMLElementCollection
Dim HTMLRow As mshtml.IHTMLElement
Dim htmlrows As mshtml.IHTMLElementCollection
Dim htmlcell As mshtml.IHTMLElement
Dim rownum As Long, colnum As Integer
Dim HTMLInnerTables As mshtml.IHTMLElementCollection
Dim HTMLInnerTable As mshtml.IHTMLElement
Dim HTMLInnerRow As mshtml.IHTMLElement
Dim HTMLInnerows As mshtml.IHTMLElementCollection
Dim innerhtmlcell As mshtml.IHTMLElement

Set htmlTables = htmlpage.getElementsByTagName("table")
Set HTMLInnerTables = htmlpage.getElementsByTagName("table")
Set HTMLInnerRows = htmlpage.getElementsByTagName("tr")

    For Each htmlTable In htmlTables
        If htmlTable.getAttribute("id") <> "main-table" Then
        GoTo line4
        End If

        Worksheets.Add
        Range("a1").Value = htmlTable.className
        Range("b1").Value = Now
        rownum = 2

            For Each HTMLRow In htmlTable.getElementsByTagName("tr")
                If HTMLRow.getAttribute("bgcolor") = "#ffffff" Or HTMLRow.getAttribute("class") = "lop" Then
                    GoTo line6
                End If
                colnum = 1

              For Each htmlcell In HTMLRow.getElementsByTagName("td") [line 6]
                        If htmlcell.getAttribute("nowrap") = "nowrap" Then
                        GoTo line1
                        Else
                        If htmlcell.getAttribute("colspan") = 2 Then
                            Cells(rownum, colnum) = htmlcell.innerText
                            rownum = rownum + 1
                            Call stupidcell
                            Else
                        End If
                        For Each HTMLInnerTable In htmlcell.getElementsByTagName("table")
                            If HTMLInnerTable.getAttribute("id") <> "main-table" Then
                                GoTo line1
                            End If
                        Next HTMLInnerTable
                            For Each HTMLInnerRow In htmlcell.getElementsByTagName("tr")
                                If HTMLInnerRow.getAttribute("bgcolor") = "#ffffff" Then
                                    GoTo line1
                                End If
                            Next HTMLInnerRow [line5]
                        Next HTMLInnerTable
                        Cells(rownum, colnum) = htmlcell.innerText [line2]
                        colnum = colnum + 1
                    Next htmlcell [line1]
                    rownum = rownum + 1
            Next HTMLRow [line3]
        Next htmlTable [line4]
End Sub

Ответы [ 3 ]

0 голосов
/ 08 ноября 2018

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

Определенно не подход «веб-стандартов», ноиногда грубым и готовым методом легче управлять, и нет смысла становиться слишком сложным, когда небольшое изменение в макете страницы может испортить все это.

Sub NIHTable()

    Dim htmlpage, tbl, rw, cl, rownum, cellNum

    'populate htmlpage

    Set tbl = htmlpage.document.getElementById("main-table")
    rownum = 0
    For Each rw In tbl.Rows
        rownum = rownum + 1
        Debug.Print "------ Row# " & rownum
        cellNum = 0
        For Each cl In rw.Cells
            cellNum = cellNum + 1
            Debug.Print , cellNum, Trim(Replace(cl.innerText, vbCrLf, ";"))
        Next cl
    Next rw

End Sub

Пример вывода строки:

------ Row# 9
               1            
               2            1 R43 CA23616401
               3            
               4            DEVELOPMENT OF TARGETED, SAFE AND EFFECTIVE DRUGS AGAINST PANCREATIC DUCTAL ADENOCARCINOMA (PDAC) BY LEVERAGING A NOVEL, COMPREHENSIVE, COMPUTATIONAL DRUG DISCOVERY APPROACH
               5            HEUER, TIM S.
               6            TWOXAR, INC.
               7            2018
               8            NCI
               9            ,NCI ,,$225,030
               10           
0 голосов
/ 08 ноября 2018

Без фактического использования HTML это не проверено. Я особенно не вижу, какие другие элементы могут соответствовать следующему шаблону селектора CSS.

У элементов, которые вы хотите, есть table помеченных родителей. Более конкретно, они находятся в дочернем элементе td с классом lop, который имеет атрибут align, который находится внутри элемента tr с классом lop. Использование синтаксиса CSS-потомков, который выглядит следующим образом:

table tr.lop [align]td.lop

Вы можете собрать элементы, соответствующие этому шаблону, с помощью querySelectorAll метода HTMLDocument следующим образом:

Dim nodeList As Object, i As Long
Set nodeList = htmlpage.querySelectorAll("table tr.lop [align]td.lop
")
For i = 0 To nodeList.Length-1
    Debug.Print Trim$(nodeList.item(i).innerText)
Next

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

Dim nodeList As Object, i As Long, dict As Object
Set nodeList = htmlpage.querySelectorAll("table tr.lop [align]td.lop")
Set dict = CreateObject("Scripting.Dictionary")

For i = 0 To nodeList.Length - 1
    dict(Trim$(nodeList.item(i).innerText)) = vbNullString
Next
Dim arr()
arr = dict.keys '<== retrieve unique values
0 голосов
/ 08 ноября 2018

Это , а не ответ и поэтому, вероятно, будет помечено, но это единственный способ оставить комментарий, включая графику, так что, возможно, S.O. Боги позволят этому скользить (иначе я просто удалю!)


Когда у меня есть сложный набор вложенных For 's / If, я скопирую его в текстовый редактор (предпочтительно Notepad ++) и удалю весь код, кроме вложенных частей, и организую его так что я вижу, где моя проблема.

Первая процедура вложена правильно:
img

Вторая процедура имеет проблему, отмеченную красным:
img

Вы закрываете For для HTMLInnerTable дважды.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...