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

Question

Это мой первый пост, и я совсем нубиш! Прошу прощения за неосмотрительность моего вопроса.

Что я хотел бы сделать, это извлечь рейтинг из http://www.appdata.com/leaderboard/app_store_apps?id=3781-top-free-apps

вот выдержка из HTML

   <tr>
          <td style="width:10px;" valign="top">3.</td>
          <td class="name" style="width:360px;" align="left">





              <img alt="The Official Masters Tournament" height="16" src="http://a5.mzstatic.com/us/r1000/082/Purple/v4/7b/db/9e/7bdb9e4a-7dea-6cb9-e46f-eba29f1d68a3/yzdmBWtm3FestDVRYi9gYg-temp-upload.mislucox.175x175-75.jpg" width="16" />
              &nbsp;
              <a href="/ios_apps/apps/4435931-the-official-masters-tournament">The Official Masters Tournament</a>                

          </td>

          <td align="right" style="padding-right:10px">

            3

          </td>







            <td align="right" style="color:black;; padding-right:10px">=</td>


      </tr>

      <tr>
          <td style="width:10px;" valign="top">4.</td>
          <td class="name" style="width:360px;" align="left">
              <img alt="LEGO® Ninjago: Rise of the Snakes" height="16" src="http://a1.mzstatic.com/us/r1000/063/Purple/v4/d8/3d/e0/d83de000-7ba6-1b0c-837a-7a7f6ca9dccf/mzl.ttwivuek.175x175-75.jpg" width="16" />
              &nbsp;
              <a href="/ios_apps/apps/4397421-lego-ninjago-rise-of-the-snakes">LEGO® Ninjago: Rise of the Snakes</a>

          </td>

          <td align="right" style="padding-right:10px">

            4

          </td>

            <td align="right" style="color:black;; padding-right:10px">=</td>

      </tr>

и экспортируйте его в Excel.

Я мог бы скопировать вставить (чтобы превзойти), но рейтинг много страниц. Мне нужно будет скопировать, вставить, нажать следующую страницу, скопировать, вставить ...

Можете ли вы придумать решение? Большое спасибо !!

Answer 1

Вот что вы можете сделать, хотя это не совсем то, что вы просите.

В Excel 2007/2010 перейдите на вкладку «Данные», в группе «Получить внешние данные» нажмите «ИзWeb».Там будет место для ввода в URL, введите его там: http://www.appdata.com/leaderboard/app_store_apps?fanbase=0&id=3781-top-free-apps&metric_select=mau&page=1

Это то же самое, что вы показали, но со страницей, установленной на 1 в URL.Там будет желтая коробка с черной стрелкой, которая указывает на стол, на который вы хотите посмотреть.Нажмите на эту стрелку.

Затем она попросит вас поместить ее в вашу рабочую книгу.Я поместил его в Sheet2 (если вы выбираете другой лист, вы должны изменить код, заменив Sheet2 именем вашего рабочего листа).Это добавило QueryTable, которое будет отображать нужные данные в ячейках Excel.

Затем можно добавить код VBA для циклического перемещения по страницам.Нажмите Alt + F11 , чтобы перейти в редактор Visual Basic.Создайте новый модуль и вставьте туда этот код:

Sub previousPage()
    Call switchPage(-1)
End Sub


Sub nextPage()
    Call switchPage(1)
End Sub

Sub switchPage(num As Integer)
    Dim q As QueryTable
    Set q = Sheet2.QueryTables(1)
    Dim currentPage As String
    Dim nextPage As String
    currentPage = Mid(q.Connection, InStr(1, q.Connection, "page=", vbTextCompare) + Len("page="), 2)
    If (IsNumeric(currentPage)) Then
        nextPage = CInt(currentPage) + num
    End If
    q.Connection = "URL;http://www.appdata.com/leaderboard/app_store_apps?fanbase=0&id=3781-top-free-apps&metric_select=mau&page=" & nextPage
    q.Refresh BackgroundQuery:=False
End Sub

Этот код выполняет циклическое перемещение по страницам.Когда запускается nextPage(), он изменит URL-адрес для перехода на страницу 2. Идея понятна.

Здесь вы можете добавить кнопки над таблицей в Sheet2 и подключить их к previousPage() и nextPage().

Answer 2

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

Редактировать: я изменил код, добавив в него «только значения для копирования» на другой лист, чтобы вы могли сохранитьданные статически.

Вот код:

Sub createQueryTable()
    Dim wsQuery As Excel.Worksheet
    Dim wsValues As Excel.Worksheet
    Dim q As Excel.QueryTable
    Dim destination As Excel.Range
    Dim connection As String
    Dim lastRow As Long, currentRow As Long
    Dim i As Long

    Set wsValues = ThisWorkbook.Worksheets.Add
    Set wsQuery = ThisWorkbook.Worksheets.Add

    Set destination = ActiveSheet.Range("A1")
    connection = "URL;http://www.appdata.com/leaderboard/app_store_apps?fanbase=0&id=3781-top-free-apps&metric_select=mau&page="
    lastRow = 1

    For i = 1 To 100
        If (lastRow <> currentRow) Then
            currentRow = lastRow
        Else
            Exit For
        End If
        Set q = wsQuery.QueryTables.Add(connection:=connection & i _
                                        , destination:=wsQuery.Cells(currentRow, "A") _
                                        )
        q.Name = "app_store_apps?fanbase=0&id=3781-top-free-apps&metric_select=mau&page=" & i
        q.WebTables = "8"
        q.RowNumbers = False
        q.BackgroundQuery = True

        If (currentRow = 1) Then
            q.FieldNames = True
        Else
            q.FieldNames = False
        End If

        q.Refresh BackgroundQuery:=False

        lastRow = getNextAvailableRow(wsQuery, "A")
    Next

    wsQuery.Range("A1", wsQuery.Cells.SpecialCells(xlCellTypeLastCell)).Copy
    wsValues.Range("A1").PasteSpecial Paste:=xlPasteValues
    wsValues.Activate
    Application.CutCopyMode = False
End Sub

Function getNextAvailableRow(ByRef ws As Excel.Worksheet, ByRef columnLetter As String) As Long
    Dim r As Long
    r = ws.Cells(ws.Rows.Count, columnLetter).End(xlUp).Row
    getNextAvailableRow = r + 1
End Function