1

我正在写一个宏,它可以从互联网上下载天气数据。我需要能够下载的天数和气象站。

如果我选择下载几天,下面的宏可以正常工作,但如果我想下载,例如一年,宏将停止并出现“无响应”。

我找不到出现“未响应”消息的模式,有时我可以下载数月,有时我无法下载数周。

Do Until Range("B15") = Range("B18")


Range("N7").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
ActiveCell.FormulaR1C1 = "x"
ActiveCell.Offset(0, -3).Select
Selection.Copy
Range("C10").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Range("N7").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, -2).Select
Selection.Copy
Range("D10").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Range("N7").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, -1).Select
Selection.Copy
Range("E10").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False


Dim Airport_StationID As Range
Set Airport_StationID = Range("A10")

Dim Airport_date_day As Range
Set Airport_date_day = Range("C10")

Dim Airport_date_month As Range
Set Airport_date_month = Range("D10")

Dim Airport_date_year As Range
Set Airport_date_year = Range("E10")


AIR_URL10 = "URL;http://www.wunderground.com/history/airport/"
AIR_URL11 = Airport_StationID
AIR_URL12 = "/"
AIR_URL13 = Airport_date_year
AIR_URL14 = "/"
AIR_URL15 = Airport_date_month
AIR_URL16 = "/"
AIR_URL17 = Airport_date_day
AIR_URL18 = "/"
AIR_URL19 = "DailyHistory.html?format=1"

Dim AIR_URL_0 As String
AIR_URL_0 = AIR_URL10 & AIR_URL11 & AIR_URL12 & AIR_URL13 & AIR_URL14 & AIR_URL15 & AIR_URL16 & AIR_URL17 & AIR_URL18 & AIR_URL19

Range("A40").Select
ActiveCell.FormulaR1C1 = AIR_URL_0

    With ActiveSheet.QueryTables.Add(Connection:= _
        AIR_URL_0 _
        , Destination:=Range("Q23"))
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = False
        .RefreshPeriod = 0
        .WebSelectionType = xlEntirePage
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
Loop
4

0 回答 0