Question

这个问题对我来说太难解决，我已经尝试过，到目前为止没有任何作用......

下面的代码贯穿列O中的值，并使用该值更改网址的一部分，然后将数据提取到excel中，但有时如果某个搜索没有返回结果，那么我收到错误1004并且循环停止而不能转到下一个值......

下面的图片显示了列O中的四个值和错误消息：

O1 = N1010W
O2 = N22NA
O3 = N2345I
O4 = N992AN

在值O3上，出现错误1004并且循环停止。有没有办法跳过/取消该错误并将搜索转到下一个（O4）值？因为来自每次搜索的数据进入范围（A1：F1），（B2：F2）等等，当错误显示为O3值时，该范围（A3：F3）中的所有单元格应填充任何单词，例如， “没找到”

Option Explicit

 Sub Getdata()



Dim lastrow As Long, x As Long

Application.ScreenUpdating = False


 With Worksheets("Sheet2")

    lastrow = .Range("O" & Rows.Count).End(xlUp).Row

    For x = 2 To lastrow



        RequeryLandings .Cells(x, "O")

    Next

End With

Application.ScreenUpdating = True

End Sub

Sub RequeryLandings(address As String)

Dim ws As Worksheet



Dim NewRow As Long

With Worksheets("Sheet2")
Set ws = ActiveWorkbook.Sheets("Sheet1")




   With ws.QueryTables.Add(Connection:= _
    "URL;http://www.airport-data.com/aircraft/" & address & ".html",            Destination:=ws.Range( _
    "$A$1"))
    .Name = "N1010W"
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = False
    .RefreshOnFileOpen = False
    .BackgroundQuery = True
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .WebSelectionType = xlSpecifiedTables
    .WebFormatting = xlWebFormattingAll
    .WebTables = "2"
    .WebPreFormattedTextToColumns = True
    .WebConsecutiveDelimitersAsOne = True
    .WebSingleBlockTextImport = False
    .WebDisableDateRecognition = False
    .WebDisableRedirections = False
    .Refresh BackgroundQuery:=False

    End With
     Range("A14").Select
With ws.QueryTables.Add(Connection:= _
    "URL;http://www.airport-data.com/aircraft/" & address & ".html",      Destination:=Sheets("Sheet1").Range( _
    "$A$12"))
    .Name = "N1010W_2"
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = False
    .RefreshOnFileOpen = False
    .BackgroundQuery = True
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .WebSelectionType = xlSpecifiedTables
    .WebFormatting = xlWebFormattingAll
    .WebTables = "3"
    .WebPreFormattedTextToColumns = True
    .WebConsecutiveDelimitersAsOne = True
    .WebSingleBlockTextImport = False
    .WebDisableDateRecognition = False
    .WebDisableRedirections = False
    .Refresh BackgroundQuery:=False

End With



    DoEvents



    Dim strSplit() As String
Dim cell As Range



For Each cell In ws.Range("B2:B200")

If (cell.Value <> vbNullString) Then

    cell.Value = Split(cell.Value, "   Search")(0)

End If

Next cell



End With


    'Copy to Another Sheet

 With Worksheets("Sheet2")
NewRow = .Range("D" & Rows.Count).End(xlUp).Row + 1


If ws.Range("A54") = "Notice:" Then
    Sheets("Sheet1").Range("A54:A55").EntireRow.Delete
End If

.Range("A" & NewRow) = ws.Range("B1")
.Range("B" & NewRow) = ws.Range("B2")
.Range("C" & NewRow) = ws.Range("B4")
.Range("D" & NewRow) = ws.Range("B12")
.Range("E" & NewRow) = ws.Range("B3")


  If ws.Range("A14") = "Certification Class:" Then
 .Range("F" & NewRow) = ws.Range("B14")
  Else
     .Range("F" & NewRow) = "Unknown"
 End If



    End With





   ActiveWorkbook.Sheets("Sheet1").Range("A1:P100") = Null

   Sheets("Sheet2").Activate

   Sheets("Sheet2").Range("G1").Select




  End Sub

Answer 1

您将要使用On Error Resume Next。这并没有实际修复错误，但它确实告诉代码继续。我将您的代码复制到我的工作表中并使用代码片段运行它，然后在子RequeryLandings中打开连接。

'The Error line, after you set ws = activeWorkbook.Sheets("Sheet1")
On Error Resume Next

With ws.QueryTables.Add(Connection:= _
"URL;http://www.airport-data.com/aircraft/" & address & ".html", Destination:=ws.range( _
"$A$1"))
.Name = "N1010W"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = False
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingAll
.WebTables = "2"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False

End With

从网站获取数据

1 个答案: