Excel VBA：宏未初始化單元格值的字符串，不接受站點連接

Question

我正在嘗試向Excel VBA寫一個循環宏，該宏從工作表1中的單元格獲取飛行路徑（從1993行開始），然后將該路徑插入到計算飛行數據的網站中（Great Circle Mapper，如下所示： http： //www.gcmap.com/ ），將網站上的表格中的數據提取到工作表2中（從1996行開始），刪除多余的數據，並從飛行的英里數中刪除“ mi”（保留數值）。

我的第一個問題似乎始於宏的開頭。

我定義了計數器變量，單元格值變量和URL字符串變量（以與單元格值變量連接）時，調試顯示只有計數器變量得到了正確的初始化。 單元值變量（應該從1993行O列開始的“ 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

從Google雲端硬盤鏈接到Excel文件

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