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。

我可以复制粘贴（到excel），但排名很多页。我需要复制，粘贴，点击下一页，复制，粘贴......

你能想到一个解决方案吗？非常感谢!!

Answer 1

这是你可以做的事情，虽然这不是你要求的。

在Excel 2007/2010中，转到“数据”选项卡，在“获取外部数据”组中，单击“从Web”。将有一个地方输入网址，在那里输入这个： http://www.appdata.com/leaderboard/app_store_apps?fanbase=0&id=3781-top-free-apps&metric_select=mau&page=1

它与您展示的相同，但在网址中将页面设置为1。将有一个黄色方框，黑色箭头指向您要查看的表格。点击那个箭头。

然后它会要求您将其放在工作簿中。我把它放在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

优秀的网页：从多个页面的排名中提取数据

2 个答案: