웹에서 루프가있는 행으로 데이터 변환하기

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