vba - 使用循环将数据从 Web 转换为行

Question

我正在尝试使用我相当基本的 excel 技能来抓取大量数据。我将此用作指南（http://www.familycomputerclub.com/scrpae-pull-data-from-websites-into-excel.html），并且已经让它为我的数据工作，但现在试图修改代码满足我的要求。

我在列中列出了大约 10,000 个卷号，需要从该站点抓取数据（最后 10 位是卷号）：http ://www.winnipegassessment.com/AsmtPub/english/propertydetails/details.aspx?pgLang =EN&isRealtySearch=true&RollNumber=2011016000

基本上，我不想为每个页面下载添加新工作表（根据我上面一直使用的指南），我想将所有新数据保留在母版页上，只需将其转换到具有相应卷号的行中（可能来自 C 列）。

我的代码如下：

Sub adds()
For x = 1 To 5
Worksheets("RollNo").Select
Worksheets("RollNo").Activate
mystr = "URL;http://www.winnipegassessment.com/AsmtPub/english/propertydetails/details.aspx?pgLang=EN&isRealtySearch=true&RollNumber=2000416000.html"
mystr = Cells(x, 1)
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = x
With ActiveSheet.QueryTables.Add(Connection:=mystr, Destination:=Range("$A$2"))
'CommandType = 0
.Name = "2000416000_1"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "2,6,7"  '---> Note: many tables have been selected for import from the website
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
Next x
End Sub

Answer 1

Sub ProcessAll()
    Dim c As Range, shtData As Worksheet

    Set shtData = Worksheets("WebQuery")

    For Each c In Worksheets("RollNo").Range("A1:A5").Cells
        If c.Value <> "" Then
            FetchData c.Value
            'move fetched data to the sheet
            With c.EntireRow
                .Cells(2).Value = shtData.Range("A2").Value
                'etc....
            End With
        End If
    Next c

End Sub

Sub FetchData(rollNo)
Const BASE_URL As String = "URL;http://www.winnipegassessment.com/AsmtPub/english/" & _
           "propertydetails/details.aspx?pgLang=EN&isRealtySearch=true&RollNumber="
Dim qt As QueryTable

    With Worksheets("WebQuery")
        On Error Resume Next
        .QueryTables(1).Delete
        On Error GoTo 0
        .Cells.Clear
        With .QueryTables.Add(Connection:=BASE_URL & rollNo, Destination:=.Range("A2"))
            .Name = "2000416000_1"
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .BackgroundQuery = True
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .WebSelectionType = xlSpecifiedTables
            .WebFormatting = xlWebFormattingNone
            .WebTables = "2,6,7"
            .WebPreFormattedTextToColumns = True
            .WebConsecutiveDelimitersAsOne = True
            .WebSingleBlockTextImport = False
            .WebDisableDateRecognition = False
            .WebDisableRedirections = False
            .Refresh BackgroundQuery:=False
        End With
    End With

End Sub