Веб-парсинг Excel VBA - игнорировать одну из нескольких таблиц через HTTP-запрос XML - PullRequest
Новая
       25

Веб-парсинг Excel VBA - игнорировать одну из нескольких таблиц через HTTP-запрос XML

1 голос
/ 17 июня 2020

Мне действительно нужна помощь в выяснении фрагмента кода веб-парсинга, который я не могу заставить работать:

  • Краткая версия моего вопроса: есть ли способ написать в XML код HTTP-запроса, чтобы игнорировать таблицу на веб-странице?

Длинная версия моего вопроса: на странице есть 10 таблиц футболистов (некоторые с парой строк , некоторые с несколькими ... каждая "маленькая" таблица представляет собой уровень). Последняя таблица на странице - с таблицей id = "table_10" - представляет собой большую исчерпывающую таблицу всех позиций ... не только защитников (которым посвящена страница и меньшие таблицы)

С приведенным ниже кодом я получаю только «table_10» в моем листе Excel: 

Option Explicit

Sub ETR_QB_Tiers_XMLHTTP()

   Dim XMLPage As New MSXML2.XMLHTTP60
   Dim HTMLDoc As New MSHTML.HTMLDocument

   XMLPage.Open "GET", "https://establishtherun.com/2020-tiers-of-evan-quarterbacks/", False
   XMLPage.send

   If XMLPage.Status <> 200 Then
      MsgBox XMLPage.Status & " - " & XMLPage.statusText
      Exit Sub
   End If

   HTMLDoc.body.innerHTML = XMLPage.responseText

   ProcessHTMLPage HTMLDoc

End Sub

Option Explicit

Sub ProcessHTMLPage(HTMLPage As MSHTML.HTMLDocument)

   Dim HTMLTable As MSHTML.IHTMLElement
   Dim HTMLTables As MSHTML.IHTMLElementCollection
   Dim HTMLRow As MSHTML.IHTMLElement
   Dim HTMLCell As MSHTML.IHTMLElement
   Dim RowNum As Long, ColNum As Integer

   Set HTMLTables = HTMLPage.getElementsByTagName("table")

   For Each HTMLTable In HTMLTables
      'Debug.Print HTMLTable.ID

      Sheets("XMLHTTP").Select

      RowNum = 1
      For Each HTMLRow In HTMLTable.getElementsByTagName("tr")
         'Debug.Print vbTab & HTMLRow.innerText

         ColNum = 1
         For Each HTMLCell In HTMLRow.Children
            'Debug.Print vbTab & HTMLCell.innerText
            Cells(RowNum, ColNum) = HTMLCell.innerText
            ColNum = ColNum + 1
         Next HTMLCell

         RowNum = RowNum + 1

      Next HTML Row

   Next HTMLTable

End Sub

Когда я устанавливаю код на Debug.Print HTMLTable.ID с строка For Each HTMLTable In HTMLTables подпрограммы ProcessHTMLPage , мне представлены все 10 идентификаторов таблиц в окне Immediate Window: 

table_1
table_2
table_3
. . .
table_10

Когда я установил код на Debug.Print vbTab & HTMLRow.innertext с помощью For Each HTMLTable In HTMLTables строка, мне представлены результаты как для небольших таблиц (таблицы с 1 по 9), так и для большой таблицы (таблица 10) в окне Immediate Window: 

table_1
   TierOne
   Patrick Mahomes (QB1)Lamar Jackson (QB2)
table_2
   TierTwo
   Dak Prescott (QB3)Josh Allen (QB4)
   Deshaun Watson (QB5)Russell Wilson (QB6)
   Kyler Murray (QB7)
. . .
table_10
   RankWRRBTEQB
   1Michael Thomas (1)Christian McCaffrey (1)Travis Kelce (1)Patrick Mahomes (1)
   2Davante Adams (1)Ezekiel Elliott (1)George Kittle (1)Lamar Jackson (1)
   3Tyreek Hill (1)Saquon Barkley (1)Zach Ertz (1)Dak Prescott (2)
   ...

Итак - я знаю, что эти «меньшие» таблицы есть и доступен, но код выводит только исчерпывающий "table_10" (ниже), в то время как мне действительно нужны отдельные таблицы с 1 по 9, а не таблица 10 вообще:

Опять же ... есть ли способ игнорировать "table_10" и гарантировать, что мне даны таблицы с 1 по 9 (вместо просто "table_10")? Я так часто пытался использовать выражения «Если», что сбился со счета.

Бонусный вопрос - «меньшие» таблицы настроены по Z-образцу (т. е. - ячейка A1 - это игрок №1> ячейка B1 - это игрок №2> ячейка A2 - это игрок №3> ячейка B2 - это игрок №4, и т. д. c.). Есть ли способ заставить игроков из столбца B перейти в столбец A в порядке их ранжирования? В принципе, преобразовать два столбца в один?

1 Ответ

0 голосов
/ 17 июня 2020
• 1000 Я думаю, вы сбрасываете для каждой таблицы и перезаписываете.

Возможно, вы также захотите добавить r + 1 перед Next HTMLTable, чтобы между таблицами оставалось некоторое количество пробелов.

Вот тривиальный пример чтобы продемонстрировать:

Ваш лог c: 

Option Explicit

Public Sub Demo_XMLHTTP()

   Dim XMLPage As New MSXML2.XMLHTTP60
   Dim HTMLDoc As New MSHTML.HTMLDocument

   XMLPage.Open "GET", "https://www.w3schools.com/html/html_tables.asp", False
   XMLPage.send

   If XMLPage.Status <> 200 Then
      MsgBox XMLPage.Status & " - " & XMLPage.statusText
      Exit Sub
   End If

   HTMLDoc.body.innerHTML = XMLPage.responseText

   ProcessHTMLPage HTMLDoc

End Sub


Public Sub ProcessHTMLPage(HTMLPage As MSHTML.HTMLDocument)

   Dim HTMLTable As MSHTML.IHTMLElement
   Dim HTMLTables()
   Dim HTMLRow As MSHTML.IHTMLElement
   Dim HTMLCell As MSHTML.IHTMLElement
   Dim RowNum As Long, ColNum As Long
   Dim hTable As Variant

   HTMLTables = Array(1, 2, 3)

   For Each hTable In HTMLTables

      Set HTMLTable = HTMLPage.getElementById("customers") '<== yeah same table but imagine it is different

      ThisWorkbook.Worksheets("XMLHTTP").Select

      RowNum = 1

      With ActiveSheet

      For Each HTMLRow In HTMLTable.getElementsByTagName("tr")

         ColNum = 1

         For Each HTMLCell In HTMLRow.Children
            .Cells(RowNum, ColNum) = HTMLCell.innerText
            ColNum = ColNum + 1
         Next HTMLCell

         RowNum = RowNum + 1

      Next HTMLRow
      Set HTMLTable = Nothing
      .Cells(RowNum, ColNum + 1) = hTable '< note which iteration we are viewing
      End With

   Next hTable

End Sub

По сравнению: 

Option Explicit

Public Sub Demo_XMLHTTP()

   Dim XMLPage As New MSXML2.XMLHTTP60
   Dim HTMLDoc As New MSHTML.HTMLDocument

   XMLPage.Open "GET", "https://www.w3schools.com/html/html_tables.asp", False
   XMLPage.send

   If XMLPage.Status <> 200 Then
      MsgBox XMLPage.Status & " - " & XMLPage.statusText
      Exit Sub
   End If

   HTMLDoc.body.innerHTML = XMLPage.responseText

   ProcessHTMLPage HTMLDoc

End Sub


Public Sub ProcessHTMLPage(HTMLPage As MSHTML.HTMLDocument)

   Dim HTMLTable As MSHTML.IHTMLElement
   Dim HTMLTables()
   Dim HTMLRow As MSHTML.IHTMLElement
   Dim HTMLCell As MSHTML.IHTMLElement
   Dim RowNum As Long, ColNum As Long
   Dim hTable As Variant

   HTMLTables = Array(1, 2, 3)

   RowNum = 1

   For Each hTable In HTMLTables

      Set HTMLTable = HTMLPage.getElementById("customers") '<== yeah same table but imagine it is different

      ThisWorkbook.Worksheets("XMLHTTP").Select

      With ActiveSheet

      For Each HTMLRow In HTMLTable.getElementsByTagName("tr")

         ColNum = 1

         For Each HTMLCell In HTMLRow.Children
            .Cells(RowNum, ColNum) = HTMLCell.innerText
            ColNum = ColNum + 1
         Next HTMLCell

         RowNum = RowNum + 1

      Next HTMLRow
      Set HTMLTable = Nothing
      .Cells(RowNum, ColNum + 1) = hTable '< note which iteration we are viewing
      End With

   Next hTable

End Sub

Игнорировать таблицу 10:

Вы можете использовать For i = 0 To HTMLTables.Length - 2 вместо For Each, чтобы игнорировать последнюю таблицу. Доступ к любой данной таблице с помощью HTMLTables.item(i). В противном случае вы можете проверить идентификатор и проигнорировать на основе этого или даже на основе индекса (не забудьте -1). Я бы, наверное, использовал id как более надежный. Обычно вы запускаете .Length-1.

Бонус:

Я не могу работать с вашей тестовой страницей, но если вы сделаете For Loop , вы можете настроить столбец для записи в зависимости от того, является ли i четным или нечетным (например, используйте MOD); Odd number MOD 2 = 1; Even MOD 2 = 0, затем отрегулируйте ColNum с -1 или, если необходимо.

...