Excel VBA：マクロがセル値の文字列を初期化せず、サイト接続を受け付けない

Question

Excel VBAにシート1（行1993から始まる）のセルから飛行経路をとり、パスを挿入するループマクロを作成しようとしています。 （Great Circle Mapper：http://www.gcmap.com/）を計算し、ウェブサイト上の表から2行目（1996年の行から）にデータを取り出し、余分なデータを削除し、マイルから「mi」を削除するWebサイトに移動します飛行（数値を残す）。

私の最初の問題は、マクロの開始から始まるようです。

カウンタ変数、セル値変数、URL文字列変数（セル値変数と連結する）を定義していますが、デバッグではカウンタ変数のみが正しく初期化されることがわかります。セル値変数（行1993、列0で開始するはずのFlight）は初期化されず、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変数を更新していないことです。

上記の間違いや、ActiveSheetの代わりにActiveCellを使用するなどのいくつかの構文エラーを修正するには、次のコードを使用します。

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