Попытка извлечь данные с веб-сайта в Excel. Для цикла не работает

Я пытаюсь извлечь данные о новобранцах НФЛ со следующего веб-сайта:

http://espn.go.com/college-sports/football/recruiting/rankings/_/class/2013

Мне нужно получить доступ к каждой позиции и скопировать вставить / извлечь информацию в электронную таблицу Excel. Как вы можете видеть ниже, единственное различие в URL для каждой из этих позиций - переменная в заглавных буквах. Мне нужна эта ПЕРЕМЕННАЯ, чтобы перейти от спортсмена к крайним защитникам и к широкому приемнику.

http://espn.go.com/college-sports/football/recruiting/playerrankings/_/position/VARIABLE/class/2013/view/position

Вот код, который я использую:

Dim array_example(18) As String

Sub Macro1()


        array_example(0) = "athlete"
        array_example(1) = "cornerback"
        array_example(2) = "defensive-end"
        array_example(3) = "defensive-tackle"
        array_example(4) = "fullback"
        array_example(5) = "inside-linebacker"
        array_example(6) = "kicker"
        array_example(7) = "offensive-center"
        array_example(8) = "offensive-guard"
        array_example(9) = "outside-linebacker"
        array_example(10) = "offensive-tackle"
        array_example(11) = "quarterback-dual-threat"
        array_example(12) = "quarterback-pocket-passer"
        array_example(13) = "running-back"
        array_example(14) = "safety"
        array_example(15) = "tight-end-h"
        array_example(16) = "tight-end-y"
        array_example(17) = "wide-receiver"

        For i = 0 To 17

            LastUsedRow = ActiveSheet.Range("A1").Offset(Sheet1.Rows.Count - 1, 0).End(xlUp).Row

            LastEmptyRow = LastUsedRow + 1

            Cell = "A" & LastEmptyRow


            With ActiveSheet.QueryTables.Add(Connection:="URL;http://espn.go.com/college-sports/football/recruiting/playerrankings/_/position/" & array_example(i) & "/class/2013/view/position" & "", Destination:=Range("" & Cell & ""))
                .Name = "s"
                .FieldNames = True
                .RowNumbers = True
                .FillAdjacentFormulas = False
                .PreserveFormatting = True
                .RefreshOnFileOpen = False
                .BackgroundQuery = True
                .RefreshStyle = xlInsertEntireCells
                .SavePassword = False
                .SaveData = True
                .AdjustColumnWidth = True
                .RefreshPeriod = 0
                .WebSelectionType = xlAllTables
                .WebFormatting = xlWebFormattingNone
                .WebPreFormattedTextToColumns = True
                .WebConsecutiveDelimitersAsOne = False
                .WebSingleBlockTextImport = False
                .WebDisableDateRecognition = False
                .WebDisableRedirections = False
                .Refresh BackgroundQuery:=True


            End With

        Next i

End Sub

Моя проблема в том, что каждый раз, когда я запускаю этот код, Excel застревает (есть маленький круглый диск, который продолжает вращаться для курсора). Когда я нажимаю Escape, чтобы остановить код, я обнаруживаю, что только одна позиция была скопирована в электронную таблицу Excel. Можете ли вы взглянуть на мой код и сообщить, что я могу изменить, чтобы он перебрал все позиции и скопировал всю информацию (одну за другой) в электронную таблицу?

Благодаря тонну.

Источник

2 ответа

Решение

Когда я впервые запустил код, у меня был тот же опыт, который вы описали. Я ждал около 2 минут и убил процесс, чтобы найти, что только первые 100 были загружены.

Я вошел и изменил эту строку на false так что я мог видеть его загрузку.

.Refresh BackgroundQuery:=False

Я также добавил строку отладки перед Next i так что я могу посмотреть, действительно ли он перебирает все адреса.

    End With
  Debug.Print "next " & i
Next i

Теперь, когда я запустил его, потребовалось всего около 30 секунд и завершил все 18 адресов. Результаты, где более 3000 строк в Excel.

Затем я добавил простой таймер, чтобы увидеть, сколько времени занимает каждый шаг. На этот раз это заняло всего 12 секунд.

next 0 - 0 seconds
next 1 - 1 seconds
next 2 - 1 seconds
next 3 - 1 seconds
next 4 - 0 seconds
next 5 - 0 seconds
next 6 - 3 seconds
next 7 - 1 seconds
next 8 - 0 seconds
next 9 - 1 seconds
next 10 - 0 seconds
next 11 - 0 seconds
next 12 - 2 seconds
next 13 - 1 seconds
next 14 - 0 seconds
next 15 - 0 seconds
next 16 - 1 seconds
next 17 - 0 seconds
Total Time: 12

Затем изменил backgroundQuery обратно на true. Таймер отсчитывал все 18 менее чем за 1 секунду и отображал только первые 100 результатов. Казалось, что Excel выполнял код до того, как все соединения были установлены, поэтому у него было достаточно времени, чтобы установить первое.

Итак, я бы предложил просто установить фоновый запрос на false. Время составляло от 12 до 30 секунд каждый раз, когда я пытался.

Здесь вы можете видеть, что он прошел через широкий приемник.

введите описание изображения здесь

NESTED LOOP ВОПРОС

Напишите внешний цикл как ваш годовой цикл. Так до For i = 0 To 17 Добавь это:

  For x = 2006 to 2013
    For i = 0 To 17

     '...continue your code

     ' Change With line to this:
     With ActiveSheet.QueryTables.Add(Connection:="URL;http://espn.go.com/college-sports/football/recruiting/playerrankings/_/position/" & array_example(i) & "/class/" & CStr(x) & "/view/position" & "", Destination:=Range("" & Cell & ""))

     '...continue your code

   Next i
  Next x
End Sub
Источник

Ваш код работает нормально. Возможно, у вас медленное / нет подключения к интернету для получения данных.

вот как это выглядит

Страница Excel

Я получаю 100 WR. Если я запускаю цикл только в первый раз и останавливаю его, я получаю 100 ATH.

Похоже, что ваш цикл работает и ставит QueryTable в одну строку, а затем перед заполнением данных помещает следующую строку на одну строку ниже, возможно, перезаписывая ее. Я бы вместо этого поместил каждый в отдельную таблицу.

Источник
Другие вопросы по тегам