касательно импорта данных из Web

[Volodymyr]

добрый день!
Прошу Вас помочь решить следующую задачу:
в интернете, по ссылке
http://imo.co.broome.ny.us/viewlist....wis=all&page=1
есть таблица котрую я хочу перенести в excel (все 1357 страниц)
В этой таблице, встолбце Tax_ID тоже есть данные, которые меня интересуют. Мой вопрос заключается в том, как средствами Excel организовать импорт основной таблицы иданных, которые находятся по ссылке Tex_ID.

Макрос обрабатывает с 1249 по 1357 страницы, т.к. кол-во строк в Excel не позволяет обрабатать сразу всю таблицу.

Дальше я думал попытатся импортровать данные, имея все гиперссыли на интересующие меня данные.


Прошу Вашего совета по моему вопросу.

с уважнием, Владимир.

Sub tmp3()
it = 1249
tt = 0
Do While it <= 1357
If it = 1249 Then tt = 1 Else tt = (it - (it - 1)) + ((it - (it - 1)) * 100 + 1) - 1 - 100
With ActiveSheet.QueryTables.Add(Connect ion:= _
"URL;http://imo.co.broome.ny.us/viewlist.aspx?sort=printkey&swis=al l&page=" & it, _
Destination:=Range("$A$" & tt))
.Name = "viewlist.aspx?sort=printkey&swis=a ll&page=" & it
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = False
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingAll
.WebTables = """tblList"""
.WebPreFormattedTextToColumns = False
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
it = it + 1
Loop
End Sub

[Volodymyr]

добрый день!
прошу подсказать, почему в процессе работы макроса, его скорость замедляется, а со временем (примерно через 2000 обработанных строк), выскакивает ошибка 1004 с сообщением, что не может подключиться к серверу?

спасибо за помощь,
с уважением, Владимир.

Sub tmp_ss()
Application.EnableCancelKey = xlDisabled
Application.ScreenUpdating = False
Application.DisplayAlerts = False
aa0 = 0
Set r = Sheets(2).Range("B:B")
aa0 = r.Columns.End(xlDown).Row
it = 2
Do While it <= aa0
Dim page2 As Range
Set page2 = Sheets(3).Range("a1:b14")
Dim page1 As Range
Set page1 = Sheets(2).Range("c" & it & ":r" & it)
tt1 = Sheets(2).Range("B" & it)
    Worksheets(3).Select
    'Range("A1").Select
    With Worksheets(3).QueryTables.Add(Connection:= _
        "URL;http://www.xxx.xxx_No=" & tt1 _
        , Destination:=Worksheets(3).Range("$A$1"))
        .Name = "xxx.xxx_No=" & tt1
        .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 = "1"
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
    page1(1) = page2(3, 1).Value
    page1(2) = page2(3, 2).Value
    page1(3) = page2(4, 1).Value
    page1(4) = page2(4, 2).Value
    page1(5) = page2(5, 1).Value
    page1(6) = page2(5, 2).Value
    page1(7) = page2(6, 1).Value
    page1(8) = page2(6, 2).Value
    page1(9) = page2(9, 1).Value
    page1(10) = page2(9, 2).Value
    page1(11) = page2(10, 1).Value
    page1(12) = page2(11, 1).Value
    page1(13) = page2(12, 1).Value
    page1(14) = page2(13, 1).Value
    page1(15) = page2(14, 1).Value
    page1(16) = page2(1, 1).Value
    Sheets(3).Range("A1:b14").Delete
        it = it + 1
Loop
Set page1 = Nothing: Set page2 = Nothing
MsgBox "the end"
Application.EnableCancelKey = True
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

[EducatedFool]

почему в процессе работы макроса, его скорость замедляется

Вы создаёте веб-запросы командой Worksheets(3).QueryTables.Add
а кто их удалять будет?
После строки .Refresh BackgroundQuery:=False
надо считать с листа полученные данные, и удалить веб-запрос командой .Delete

Примеры есть здесь:
http://excelvba.ru/MoviesSearch
http://excelvba.ru/Rating_and_Ranking

[Volodymyr]

спасибо EducatedFool, вставлю удаление веб-запроса согласно Вашему примеру.