运行VBA时MS Excel崩溃

我有一个macros从雅虎的财务网站获取信息,根据公司的名称,并将其放入Excel中。 当我使用F8运行它时,macros和Excel运行良好。 但是,当我尝试使用F5(没有中断)来运行它时,它不会超出第5次迭代(有5.5k次迭代要完成)。

我正在运行的笔记本电脑是一个戴尔XPS与一个2.2GHz的i-7 2670QM芯片,8GB内存和一个64位操作系统(赢7)。 MS excel是2013年。

代码如下:

Sub Yahoo_Company_List() Application.ScreenUpdating = False On Error GoTo ErrorHandler a = 3 'While Worksheets("Storage Sheet").Cells(a, 1) <> vbNullString While a < 10 Worksheets("Downloads").Activate Columns.Select Selection.ClearContents Symbol = Worksheets("Storage Sheet").Cells(a, 1) With ActiveSheet.QueryTables.Add(Connection:= _ "URL;https://uk.finance.yahoo.com/q/is?s=" & Symbol & "&annual", Destination:=Range( _ "$A$1")) .Name = "is?s=" & Symbol & "&annual" .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .BackgroundQuery = True .RefreshStyle = xlInsertDeleteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .WebSelectionType = xlSpecifiedTables .WebFormatting = xlWebFormattingNone .WebTables = "9" .WebPreFormattedTextToColumns = True .WebConsecutiveDelimitersAsOne = True .WebSingleBlockTextImport = False .WebDisableDateRecognition = False .WebDisableRedirections = False .Refresh BackgroundQuery:=False End With With ActiveSheet.QueryTables.Add(Connection:= _ "URL;http://finance.yahoo.com/q/bs?s=" & Symbol & "+Balance+Sheet&annual", Destination _ :=Range("$A$41")) .Name = "bs?s=" & Symbol & "+Balance+Sheet&annual" .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .BackgroundQuery = True .RefreshStyle = xlInsertDeleteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .WebSelectionType = xlSpecifiedTables .WebFormatting = xlWebFormattingNone .WebTables = "9" .WebPreFormattedTextToColumns = True .WebConsecutiveDelimitersAsOne = True .WebSingleBlockTextImport = False .WebDisableDateRecognition = False .WebDisableRedirections = False .Refresh BackgroundQuery:=False End With Range("A91").Select With ActiveSheet.QueryTables.Add(Connection:= _ "URL;http://finance.yahoo.com/q/cf?s=" & Symbol & "+Cash+Flow&annual", Destination:= _ Range("$A$91")) .Name = "cf?s=" & Symbol & "+Cash+Flow&annual" .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .BackgroundQuery = True .RefreshStyle = xlInsertDeleteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .WebSelectionType = xlSpecifiedTables .WebFormatting = xlWebFormattingNone .WebTables = "9" .WebPreFormattedTextToColumns = True .WebConsecutiveDelimitersAsOne = True .WebSingleBlockTextImport = False .WebDisableDateRecognition = False .WebDisableRedirections = False .Refresh BackgroundQuery:=False End With With ActiveSheet.QueryTables.Add(Connection:= _ "URL;https://uk.finance.yahoo.com/q?s=" & Symbol & "&ql=1", Destination:=Range("$A$122")) .Name = "q?s=" & Symbol & "&ql=1_1" .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .BackgroundQuery = True .RefreshStyle = xlInsertDeleteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .WebSelectionType = xlSpecifiedTables .WebFormatting = xlWebFormattingNone .WebTables = """table1"",""table2""" .WebPreFormattedTextToColumns = True .WebConsecutiveDelimitersAsOne = True .WebSingleBlockTextImport = False .WebDisableDateRecognition = False .WebDisableRedirections = False .Refresh BackgroundQuery:=False End With Call Reformatting_m.reformatting Worksheets("Calculations").Activate Range("B:F").Select Selection.ClearContents i = 1 While i < 109 m = 1 If Cells(i, 1) <> vbNullString Then While m <= 3 DataValue = WorksheetFunction.VLookup(Cells(i, 1), Worksheets("Downloads").Range("A1:F200"), 1 + m, False) If Not IsError(DataValue) Then Cells(i, 1 + m) = DataValue End If If Cells(i, 1) = "Period Ending" Then Cells(i, 1 + m).NumberFormat = "m/d/yyyy" Else Cells(i, 1 + m).NumberFormat = 0 End If m = m + 1 Wend End If i = i + 1 Wend Call FScore_m.FScoreCalc ' Application.Calculate Worksheets("Storage Sheet").Activate n = 5 k = 8 p = 2 While n < 67 If ((p = 9 Or p = 10 Or p = 11 Or p = 12 Or p = 13 Or p = 27) And k = 10) Or k = 11 Or _ ((p = 21 Or p = 22 Or p = 23 Or p = 24 Or p = 25 Or p = 26) And k = 9) Then k = 8 p = p + 1 ElseIf k < 11 Then Cells(a, n) = Worksheets("Calculations").Cells(p, k) k = k + 1 n = n + 1 End If Wend a = a + 1 Wend Application.ScreenUpdating = True ErrorHandler: Application.ScreenUpdating = True Exit Sub End Sub 

任何关于如何让macros工作的build议?

我不能给你一个完整的答案,因为我们没有访问Call过程中的代码(例如Reformatting_m.reformatting ),他们可能会导致这个问题,但我有一个类似的东西在一些广泛的Word自动化,它几乎就像是内存不足,会“随机”崩溃。

我强烈推荐的最好build议是创buildvariables并在其中工作。 例如: –

 Option Explicit Sub Yahoo_Company_List() Dim a As Long Dim Wkbk As Excel.Workbook Dim WkSht_Downloads As Excel.Worksheet Application.ScreenUpdating = False On Error GoTo ErrorHandler Set WkBk = ThisWorkbook Set WkSht_Downloads = WkBk.Worksheets("Downloads") While a < 10 WkSht_Downloads.Columns.ClearContents End While Set WkSht_Downloads = Nothing Set WkBk = Nothing 

像这样工作会减less连接到工作簿的含义,这意味着资源将是免费的,并且可能不会发生崩溃。