Question

我正在尝试为Excel VBA写一个循环宏，它从Sheet 1中的单元格（从第1993行开始）获取飞行路径，将路径插入到计算飞行数据的网站中（Great Circle Mapper，此处显示）：http://www.gcmap.com/），将数据从网站上的表格拉到表格2（从第1996行开始），删除多余的数据，并从飞行里程中删除“mi”（留下数值）。

我的第一个问题似乎从宏的开始开始。

虽然我已经定义了计数器变量，单元格值变量和URL字符串变量（以与单元格值变量连接），但调试显示只有计数器变量才能正确初始化。单元格值变量（“Flight”应该从第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

Excel VBA：宏未初始化单元格值的字符串，不接受站点连接

1 个答案: