VBA 运行-29738行后时间错误1004

Question

大家好。我是 VBA 的新手，正在使用以下代码弄清楚如何查询多个表。我希望代码达到 100000 行，但我想看看它实际上可以走多远运行。可悲的是，在第 29714 行之后，它给了我：运行-时间错误 1004 'Application-defined or object-defined error'。除了循环参数可能太大之外，我不知道出了什么问题。有什么想法吗？

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。之后，我只需更改与下一个单元格的连接。网址现在在每一行中，而不是每 24 行。代码遍历它们并将输出复制到每个新的 sheet。我的测试只涉及两个站点。我不知道它会让你在失败之前创建多少：

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

VBA 运行-29738行后时间错误1004

VBA Run-Time Error 1004 After 29738 Rows

excel

vba

excel-2013