运行VBA

Question

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

我正在运行的笔记本电脑是戴尔XPS，带有i-7 2670QM芯片@ 2.2GHz，8GB RAM和64位操作系统（Win 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

有关如何使宏工作的任何建议吗？

Answer 1

我无法给你一个完整的答案，因为我们无法访问Call程序中的代码（例如Reformatting_m.reformatting）并且它们可能导致问题，但我有类似的在一些广泛的Word自动化中，它几乎就像是内存耗尽而且会“随机”崩溃。

我强烈建议的最佳建议是创建变量并使用它们。例如： -

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

这样工作导致与工作簿的连接减少意味着资源将是免费的，并且可能不会发生崩溃。