Как исправить ошибку времени выполнения «7» из памяти, которая сохраняется даже после сохранения, закрытия, перезагрузки компьютера - PullRequest
Новая
       43

Как исправить ошибку времени выполнения «7» из памяти, которая сохраняется даже после сохранения, закрытия, перезагрузки компьютера

0 голосов
/ 20 декабря 2018

Мой макрос VBA Excel выдает «Ошибка времени выполнения« 7 »: недостаточно памяти»

В документе Excel содержится список из 5500 документов CSV на одном листе.Макрос просматривает этот список и для каждого: а) помещает свою информацию в сводный выходной лист;б) добавляет некоторые формулы;и c) переходит к следующему файлу.

После выполнения около 3000 из них сценарий обнаружил ошибку «Недостаточно памяти».

Основная проблема заключается в том, что эта проблема сохраняется после сохранения файла.закрытие Excel полностью, повторное открытие Excel и даже перезагрузка компьютера.Я также использовал Paste-Special, чтобы избавиться от всех формул и заменить их значениями.Я также переключился на ручные вычисления.

Я хотел бы найти способ предотвратить возникновение этой ошибки.Как минимум, если это произойдет, я хотел бы иметь возможность сохранять, закрывать и повторно открывать файл и продолжать просматривать список из 3000 записей одновременно.

Я прочитал всепредыдущие вопросы и ответы об ошибках «Недостаточно памяти», но ни одна из них, похоже, не устраняет проблему после закрытия и повторного открытия.

Я публикую соответствующую часть своего кода ниже.Отладчик показывает, что ошибка произошла в строке: .Refresh BackgroundQuery: = False.Я использую Windows 10, Excel 2007. Любая помощь приветствуется.Спасибо! 

Sub test()

Dim filename As String
Dim outputsheet As String
Dim output_lastrow As Integer

Application.EnableEvents = False

For rep = 2 To 5502
    filename = Sheets("Import Files").Range("A" & rep).Value ‘this takes the form of C:\Users\...\filename1.csv
    outputsheet = "Summary"
    output_lastrow = Sheets(outputsheet).Range("D999999").End(xlUp).Row

    With ActiveSheet.QueryTables.Add(Connection:="TEXT;" + filename, Destination:=Sheets(outputsheet).Range("$A" & output_lastrow + 2))
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .TextFilePromptOnRefresh = False
            .TextFilePlatform = 437
            .TextFileStartRow = 1
            .TextFileParseType = xlDelimited
            .TextFileTextQualifier = xlTextQualifierDoubleQuote
            .TextFileConsecutiveDelimiter = False
            .TextFileTabDelimiter = False
            .TextFileSemicolonDelimiter = False
            .TextFileCommaDelimiter = True
            .TextFileSpaceDelimiter = False
            .TextFileTrailingMinusNumbers = True
            .Refresh BackgroundQuery:=False
    End With

        output_lastrow = Sheets(outputsheet).Range("D999999").End(xlUp).Row + 1
        Sheets(outputsheet).Range("A" & output_lastrow).Value = "Change"
        Sheets(outputsheet).Range("B" & output_lastrow).Formula = "=R[-1]C"
        Sheets(outputsheet).Range("C" & output_lastrow).Formula = "=R[-1]C"
        Sheets(outputsheet).Range("C" & output_lastrow).AutoFill Destination:=Range("C" & output_lastrow & ":FP" & output_lastrow), Type:=xlFillDefault

    End If

    Dim wbconnection As WorkbookConnection
    For Each wbconnection In ActiveWorkbook.Connections
        If InStr(filename, wbconnection.Name) > 0 Then
            wbconnection.Delete
        End If
    Next wbconnection

Next rep

1 Ответ

0 голосов
/ 20 декабря 2018

Поскольку вы можете просто открыть файл CSV с помощью Workbooks.Open в режиме «Готов только», а затем скопировать данные, как если бы вы работали с обычной рабочей таблицы, попробуйте следующее: 

Sub Test()
    Dim filename As String
    Dim outputsheet As String
    Dim output_lastrow As Integer
    Dim wbCSV AS Workbook

    outputsheet = "Summary"

    Application.EnableEvents = False

    For rep = 2 To 5502
        filename = Sheets("Import Files").Cells(rep, 1).Value ‘this takes the form of C:\Users\...\filename1.csv
        output_lastrow = Sheets(outputsheet).Cells(Sheets(outputsheet).Rows.Count, 4).End(xlUp).Row

        'Open CSV File
        Set wbCSV = Workbooks.Open(Filename:=filename, ReadOnly:=True)

        'Copy data to outputsheet
        wbCSV.Worksheets(1).UsedRange.Copy Destination:=ThisWorkbook.Sheets(outputsheet).Cells(output_lastrow + 1, 1)

        'Close CSV File
        wbCSV.Close False
        Set wbCSV = Nothing
    Next rep

    Application.EnableEvents = True
End Sub

Если вы храните rep где-нибудь в Рабочей книге и сохраняйте его время от времени (ThisWorkbook.Save), а затем, даже если произойдет сбой, вы можете просто возобновить цикл с последней сохраненной точки

...