0

かなり基本的な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 =JA&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
4

1 に答える 1

0 
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
于 2013-08-14T18:46:29.007 に答える