Excel VBA: макрос не инициализирует строки для значения соты, не принимает подключение к сайту

Question

Я пытаюсь написать макрос цикла в Excel VBA, который берет траекторию полета из ячейки в Листе 1 (начиная с строки 1993), вставляет путь на сайт, который вычисляет данные полета (Great Circle Mapper, показанный здесь: http://www.gcmap.com/), извлекает данные из таблицы на веб-сайт в Лист 2 (начиная с строки 1996), удаляет лишние данные и удаляет «mi» с миль (чтобы оставить числовое значение).

Моя первая проблема, похоже, начинается с начала макроса.

Хотя я определил переменную счетчика, переменную переменной ячейки и строковую переменную URL (чтобы объединить с переменной значения ячейки), отладка показывает, что только контрольная переменная получает правильную инициализацию. Переменная ячейки («Полет», которая должна начинаться в строке 1993, столбец O) не инициализируется, что приводит к неправильному запуску переменных URL и имен. Показанный здесь:

ToInfinity = 1993 
Flight = Cells(ToInfinity, 15).Value 
url = "URL;http://www.gcmap.com/dist?P=" & Flight 
name = "dist?P=" & Flight 

Что касается моей второй задачи, на несколько раз макрос инициализирует каждую переменную, аргумент соединения показано здесь:

("With ActiveSheet.QueryTables.Add(Connection:= _ 
    url, Flight:=Range("$A$1996:$G$1996")) 

дает мне ошибку времени выполнения, и этот блок код выделяется отладчиком.

Полнота моего кода приведен ниже:

Sub PULLFROMGCM() 
' 
' PULLFROMGCM Macro 
' Pulls data from great circle mapper 
' 
' Keyboard Shortcut: Ctrl+Shift+T 
' 
Dim Flight As String 
'String variable for each flight path to be analyzed by the website, "Great Circle Mapper" 
' 
Dim url As String 
Dim ToInfinity As Long 
' Counter variable for loop, beginning at row 1993 on sheet 1' 
Dim name As String 
Dim Milesflown As String 
ToInfinity = 1993 
Flight = Cells(ToInfinity, 15).Value 
url = "URL;http://www.gcmap.com/dist?P=" & Flight 
name = "dist?P=" & Flight 
Do While Not IsEmpty(Cells(ToInfinity, 15)) 



Sheets("Sheet2").Select 
    With ActiveSheet.QueryTables.Add(Connection:= _ 
     url, Flight:=Range("$A$1996:$G$1996")) 
     .CommandType = 0 
     .name = name 
     .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 = """mdist""" 
    .WebPreFormattedTextToColumns = True 
    .WebConsecutiveDelimitersAsOne = True 
    .WebSingleBlockTextImport = False 
    .WebDisableDateRecognition = False 
    .WebDisableRedirections = False 
    .Refresh BackgroundQuery:=False 
End With 
Milesflown = "G:2001" 
ActiveCell.Range("A1996:G2000").Select 
Selection.QueryTable.Delete 
Selection.ClearContents 
Sheets("Sheet1").Select 

If InStr(Milesflown, "mi") <> 0 Then 
Cells(ToInfinity, 11).Value = Left(Milesflown, " ") 
End If 
ToInfinity = ToInfinity + 1 
Loop 
End Sub 

Link to Excel file from Google Drive

Answer 1

Очевидная ошибка в коде является то, что вы не обновляя Flight, url и name переменные внутри вашего цикла.

Исправление указанных ошибок и несколько синтаксических ошибок (например, использование ActiveCell вместо ActiveSheet), следующий код делает то, что вы хотите.

Sub PULLFROMGCM() 
' 
' PULLFROMGCM Macro 
' Pulls data from great circle mapper 
' 
' Keyboard Shortcut: Ctrl+Shift+T 
' 
Dim Flight As String 
Dim url As String 
Dim ToInfinity As Long 
Dim name As String 
Dim Milesflown As String 
ToInfinity = 1993 


Do While Not IsEmpty(Cells(ToInfinity, 15)) 

' Update the variables in your loop as well 
Flight = Cells(ToInfinity, 15).Value 
url = "URL;http://www.gcmap.com/dist?P=" & Flight 
name = "dist?P=" & Flight 

' Calculate how far sheet 2 has rows 
Sheets("Sheet2").Select 
HowFar = Application.WorksheetFunction.CountA(Range("A:A")) + 3 

    With ActiveSheet.QueryTables.Add(Connection:= _ 
     url, Destination:=Range("A" & (HowFar + 1) & ":G" & (HowFar + 1))) 
     .name = name 
     .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 = """mdist""" 
     .WebPreFormattedTextToColumns = True 
     .WebConsecutiveDelimitersAsOne = True 
     .WebSingleBlockTextImport = False 
     .WebDisableDateRecognition = False 
     .WebDisableRedirections = False 
     .Refresh BackgroundQuery:=False 
    End With 
    Milesflown = Range("G" & (HowFar + 6)).Value 
    ActiveSheet.Range("A" & (HowFar + 1) & ":G" & (HowFar + 5)).Select 
    Selection.QueryTable.Delete 
    Selection.ClearContents 
    Sheets("Sheet1").Select 

If InStr(Milesflown, "mi") <> 0 Then 
    Milesflown = Replace(Milesflown, "mi", "") 
    Cells(ToInfinity, 12).Value = Milesflown 
End If 

MsgBox (Milesflown) 
    ToInfinity = ToInfinity + 1 

Loop 
End Sub