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

将数据从Web转换为具有循环的行

1 个答案: