Question

我希望找到一些关于这个宏的帮助..这个想法是，在执行时，宏将从网页（IE http://www.link.com/id=7759）中提取数据并将其放入让我们说的Sheet2，然后打开第2页，并将其放在第1页的第1页数据的正下方......依此类推，直到设定的页码。理想情况下，我希望它只是按顺序拉出以下内容;

标题艺术家类型纸张尺寸图片尺寸零售奖量

更进一步理想的是放置在4行和8行的正确列和行中（列表就像在网页中一样）。

对此的任何帮助都将非常感激。我做了一些研究，发现了类似的宏，遗憾的是没有运气让他们为我工作。主要是VB也未能通过。

一些有用的信息（也许）当我试图写自己的时候，我想到了这一点，也许它会拯救曾经帮助过一段时间的人......

.WebTables = "8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38"

这些是我想要放入Que中的每个项目的表......

Answer 1

这是一个让你前进的示例方法

基于一些假设

工作簿包含一个用于保存名为“查询”
工作簿包含一个Sheet，用于将数据放入名为“AllData”的文件
运行宏
我认为你需要在qyuery中包含表7
要处理的页面硬编码为For Pg = 1 To 1，将其更改为

Sub QueryWebSite()
    Dim shQuery As Worksheet, shAllData As Worksheet
    Dim clData As Range

    Dim qts As QueryTables
    Dim qt As QueryTable
    Dim Pg As Long, i As Long, n As Long, m As Long
    Dim vSrc As Variant, vDest() As Variant

    ' setup query
    Set shQuery = ActiveWorkbook.Sheets("Query")
    Set shAllData = ActiveWorkbook.Sheets("AllData")

    'Set qt = shQuery.QueryTables(1)
    On Error Resume Next

    Set qt = shQuery.QueryTables("Liebermans")
    If Err.Number <> 0 Then
        Err.Clear
        Set qt = shQuery.QueryTables.Add( _
            Connection:="URL;http://www.liebermans.net/productlist.aspx?id=7759&page=1", _
            Destination:=shQuery.Cells(1, 1))
        With qt
            .Name = "Liebermans"
            .WebSelectionType = xlSpecifiedTables
            .WebFormatting = xlWebFormattingNone
            .WebTables = "7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38"
            .WebPreFormattedTextToColumns = True
            .WebConsecutiveDelimitersAsOne = True
            .WebSingleBlockTextImport = False
            .WebDisableDateRecognition = False
            .WebDisableRedirections = False
            .Refresh BackgroundQuery:=False
        End With
    End If
    On Error GoTo 0

    i = InStr(qt.Connection, "&page=")

    ' clear old data
    shAllData.UsedRange.ClearContents
    shAllData.Cells(1, 1) = "Title"
    shAllData.Cells(1, 2) = "Artist"
    shAllData.Cells(1, 3) = "Type"
    shAllData.Cells(1, 4) = "Paper Size"
    shAllData.Cells(1, 5) = "Image Size"
    shAllData.Cells(1, 6) = "Price"
    shAllData.Cells(1, 7) = "Quantity"


    m = 0
    ReDim vDest(1 To 10000, 1 To 7)
    For Pg = 1 To 1
        ' Query Wb site
        qt.Connection = Left(qt.Connection, i + 5) & Pg
        qt.Refresh False

        ' Process data
        vSrc = qt.ResultRange
        n = 2
        Do While n < UBound(vSrc, 1)
            If vSrc(n, 1) <> "" And vSrc(n - 1, 1) = "" Then
                m = m + 1
                vDest(m, 1) = vSrc(n, 1)
            End If
            If vSrc(n, 1) Like "Artist:*" Then vDest(m, 2) = Trim(Mid(vSrc(n, 1), 8))
            If vSrc(n, 1) Like "Type:*" Then vDest(m, 3) = Trim(Mid(vSrc(n, 1), 6))
            If vSrc(n, 1) Like "Paper Size:*" Then vDest(m, 4) = Trim(Mid(vSrc(n, 1), 12))
            If vSrc(n, 1) Like "Image Size:*" Then vDest(m, 5) = Trim(Mid(vSrc(n, 1), 12))
            If vSrc(n, 1) Like "Retail Price:*" Then vDest(m, 6) = Trim(Mid(vSrc(n, 1), 14))
            If vSrc(n, 1) Like "Quantity in stock:*" Then vDest(m, 7) = Trim(Mid(vSrc(n, 1), 19))

            n = n + 1
        Loop
    Next

    ' Put data in sheet
    shAllData.Cells(2, 1).Resize(m, 7) = vDest

End Sub

Microsoft Excel 2010 Web查询宏：从一个中提取多个页面

1 个答案: