Question

虽然我的代码适用于10次循环迭代，但它会因home = 30或更多而崩溃。有人可以给我提供线索吗？甚至更奇怪这个代码曾经工作得很好......而且不再有用了。

以下是代码：

Sub datascrap_clean()

'

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

Dim home                As Integer

Dim output_rows         As Integer
Dim output_columns      As Integer
Dim date_columns        As Integer


'Output rows and columns starting values
output_rows = 3
output_columns = 3
date_columns = 8

For home = 3 To 33

    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;http://www.cqc.org.uk/directory/" & Sheets("Output").Cells(home, 1), Destination:=Range("$A$1") _
        )
        '.CommandType = 0
        .Name = "Homes"
        .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




For x = 20 To 250
    Select Case Left(Cells(x, 1), 7)

    'Is it a score?
    Case Is = "Overall"

        Sheets("Output").Cells(output_rows, output_columns).Value = Cells(x, 1)
        output_columns = output_columns + 1

    'Is it a date?
    'Case Is = "Carried"

       ' Sheets("Output").Cells(output_rows, output_columns).Value = Cells(x, 1)
        'date_columns = date_columns + 1

    Case Else

    End Select

    Sheets(2).Select

Next x

    'Clean sheet
    ActiveSheet.Cells.Delete

    'Reset column count
    output_columns = 3
    date_columns = 8

output_rows = output_rows + 1
Next home



MsgBox ("Done!")
End Sub

Answer 1

我在循环中创建QueryTable对象并让Excel在看似随机的时间（通常在创建大约15个QueryTable对象之后）挂起时遇到了同样的问题。我注意到，当我在VBE调试并运行插入断点时，问题没有发生。因此，除了在上一个答案中建议使用它们之后删除QueryTable对象之外，我在循环开始时插入了一个短暂的延迟：

Application.Wait(Now + TimeValue("0:00:02"))

能够成功运行一个案例，其中创建了〜300个没有挂起的QueryTable对象。是的，一个kludge，但它最少提供一个解决方案。没有延迟，即使删除了QueryTable对象，我仍然可以挂起Excel。

Excel VBA脚本在运行几分钟后冻结excel

1 个答案: