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

虽然我的代码工作10循环迭代,它崩溃的家庭= 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 

我在创build一个循环内的QueryTable对象时遇到了同样的问题,并且在看似随机的时间(通常在创build了大约15个QueryTable对象之后)上挂起了Excel。 我注意到,当我在VBEdebugging和插入断点运行时,问题没有发生。 因此,除了按照之前的回答build议的方式删除QueryTable对象之外,我在循环开始时插入了一个很短的延迟:

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

能够成功运行约300个QueryTable对象的情况下创build没有挂。 是的,一个杂凑,但它至less提供了一个工作。 没有延迟,即使在删除QueryTable对象之后,我仍然会挂起Excel。