Question

大家好日子。我是VBA的新手，正在使用以下代码来弄清楚如何查询多个表。我希望代码转到100000行，但我想知道它实际运行的程度。可悲的是，在第29714行之后，它给了我：运行时错误1004＆＃39;应用程序定义的或对象定义的错误＆＃39;。除了循环参数可能太大之外，我不知道出了什么问题。有什么想法吗？

Sub Data()

Dim qtb As New QueryTable
Dim url1 As String
Dim i As Long

For i = 2 To 540602 Step 24
url1 = Sheet2.Range("A" & i)

Set qtb = Sheet2.QueryTables.Add(Connection:="URL;" & url1, Destination:=Range("B" & i))
    qtb.WebTables = "5"
    qtb.FieldNames = True
    qtb.RowNumbers = False
    qtb.FillAdjacentFormulas = False
    qtb.PreserveFormatting = True
    qtb.RefreshOnFileOpen = False
    qtb.BackgroundQuery = False
    qtb.RefreshStyle = xlInsertDeleteCells
    qtb.SavePassword = False
    qtb.SaveData = False
    qtb.AdjustColumnWidth = False
    qtb.RefreshPeriod = 0
    qtb.WebSelectionType = xlSpecifiedTables
    qtb.WebFormatting = xlWebFormattingNone
    qtb.WebPreFormattedTextToColumns = True
    qtb.WebConsecutiveDelimitersAsOne = True
    qtb.WebSingleBlockTextImport = False
    qtb.WebDisableDateRecognition = False
    qtb.WebDisableRedirections = False
    qtb.Refresh BackgroundQuery:=False
  Next i
  MsgBox ("X")
  End Sub

Answer 1

这是我想出的。正如评论中所建议的那样，我第一次创建了完整的QueryTable。之后，我只是将连接更改为下一个单元格。 Web地址现在位于每一行，而不是每24行。代码逐步执行它们并将输出复制到每个行的新工作表中。我的测试只涉及两个站点。我不知道在失败之前会让你创造多少：

Sub Data()
Dim ws As Excel.Worksheet
Dim qtb As QueryTable
Dim url1 As String
Dim i As Long

Set ws = ActiveSheet 'or ws if you prefer
For i = 2 To 3 'links are in each row
    url1 = ws.Range("A" & i)
    If i = 2 Then
        Set qtb = ws.QueryTables.Add(Connection:="URL;" & url1, Destination:=ws.Range("B1"))
        With qtb
            .WebTables = "5"
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .BackgroundQuery = True
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .WebSelectionType = xlEntirePage
            .WebFormatting = xlWebFormattingNone
            .WebPreFormattedTextToColumns = True
            .WebConsecutiveDelimitersAsOne = True
            .WebSingleBlockTextImport = False
            .WebDisableDateRecognition = False
            .WebDisableRedirections = False
            .Refresh BackgroundQuery:=False
        End With
    Else
        qtb.Connection = "URL;" & url1
        qtb.Refresh BackgroundQuery:=False
    End If
    ws.Copy after:=ws.Parent.Worksheets(ws.Parent.Worksheets.Count)
    ActiveSheet.Columns(1).EntireColumn.Delete
Next i
End Sub

在29738行之后的VBA运行时错误1004

1 个答案: