Excel VBA из памяти

Question

Я получаю сообщение об ошибке Excel VBA с памятью 007. Я использую эффективность, чтобы очистить буфер обмена, память, ограничения использования памяти и по-прежнему использовать ее во внутренней функции GetData (integer) во второй раз. Есть идеи? Я вынужден запустить 32 бита на моем govt-компьютере.

Sub RunStatusOfFunds() 

    'Declare worksheet variables 
    Dim HOME As Worksheet 
    Dim CRIS_CRITERIA_DATASHEET As Worksheet 
    Dim DEAMS_CRITERIA_DATASHEET As Worksheet 
    Dim CRITERIA_INSTRUCTIONS As Worksheet 
    Dim DEAMS_DATASHEET As Worksheet 
    Dim CRIS_DATASHEET As Worksheet 
    Dim VSF_DATASHEET As Worksheet 
    Dim CALCULATIONS As Worksheet 
    Dim STATUS As Chart 
    Dim VSF_DEAMS As Worksheet 
    Dim VSF_CRIS As Worksheet 

    'Set variables to actual worksheets 
    Set HOME = Sheets("Home") 
    Set CRIS_CRITERIA_DATASHEET = Sheets("CRIS_CRITERIA_DATASHEET") 
    Set DEAMS_CRITERIA_DATASHEET = Sheets("DEAMS_CRITERIA_DATASHEET") 
    Set CRITERIA_INSTRUCTIONS = Sheets("CRITERIA_INSTRUCTIONS") 
    Set DEAMS_DATASHEET = Sheets("DEAMS_DATASHEET") 
    Set CRIS_DATASHEET = Sheets("CRIS_DATASHEET") 
    Set VSF_DATASHEET = Sheets("VSF_DATASHEET") 
    Set CALCULATIONS = Sheets("CALCULATIONS") 
    Set STATUS = Charts("STATUS") 
    Set VSF_DEAMS = Sheets("VSF_DEAMS") 
    Set VSF_CRIS = Sheets("VSF_CRIS") 

    'Declare working variables such as counters, etc. 
    Dim z, n As Integer 

    'Declare arrays to hold data from tables 
    Dim DEAMS_data_array(0 To 67) As Variant 
    Dim DCriteria_data_array(0 To 9) As Variant 
    Dim CRIS_data_array(0 To 67) As Variant 
    Dim CCriteria_data_array() As Variant 

    'Declare location variables 
    Dim ppLocation As String 
    Dim ptLocation As String 

    Application.Calculation = xlCalculationManual 
    Application.ScreenUpdating = False 
    Application.EnableEvents = False 

    UnlockSheets   'Use password to unlock all sheets 

    'Request file locations 
    ppLocation = HOME.Cells(19, 11) 
    ptLocation = HOME.Cells(21, 11) 

    VSF_DEAMS.Range("A:Z").Clear 
    VSF_CRIS.Range("A:Z").Clear 
    DEAMS_DATASHEET.Range("A:Z").Clear 
    CRIS_DATASHEET.Range("A:Z").Clear 

    'Get DEAMS data 
    z = 0 
    z = GetData(0) 

    If z = 1 Then 
     CancelUpdate   'If no data given exit 
     LockSheets    'Lock sheets 
     HOME.Select    'Change user visual focus to Home 
     Exit Sub 
    End If 

    VSF_CRIS.Cells.Clear 

    'Get CRIS data 
    z = 0 
    z = GetData(1) 

    If z = 1 Then 
     CancelUpdate  'If no data given exit 
     LockSheets    'Lock sheets 
     HOME.Select    'Change user visual focus to Home 
    End If 

    'Copy DEAMS data 
    'Collect DEAMS headers 
    n = 1 
    For i = 0 To 67 
     DEAMS_data_array(i) = DEAMS_DATASHEET.Cells(1, n) 
     n = n + 1 
    Next i 

    n = 1 
    For i = 0 To 67 
     CRIS_data_array(i) = CRIS_DATASHEET.Cells(1, n) 
     n = n + 1 
    Next i 

    'Write DEAMS headers, add Description 
    'VSF_DEAMS.Activate 
    'VSF_DEAMS.Cells.Clear 
    'VSF_DEAMS.Cells(1, 1).Activate 
    VSF_DEAMS.Cells(1, 1).Value = "DESCRIPTION" 
    VSF_CRIS.Cells(1, 1).Value = "DESCRIPTION" 

    n = 2 
    For i = 0 To 67 
     VSF_DEAMS.Cells(1, n).Value = DEAMS_data_array(i) 
     n = n + 1 
    Next i 

    n = 2 
    For i = 0 To 67 
     VSF_CRIS.Cells(1, n) = CRIS_data_array(i) 
     n = n + 1 
    Next i 

    Call findDesc(DEAMS_DATASHEET, DEAMS_CRITERIA_DATASHEET, VSF_DEAMS) 
    Call findDesc(CRIS_DATASHEET, CRIS_CRITERIA_DATASHEET, VSF_CRIS) 

    Application.Calculation = xlCalculationAutomatic 
    Application.EnableEvents = True 

End Sub 

Sub UnlockSheets() 

    If Sheets("HOME").Cells(26, 6).Value = "Sheet is Unlocked" Then Exit Sub 

    Set CrisData = Sheets("CRIS_DATASHEET") 
    Set DEAMSData = Sheets("DEAMS_DATASHEET") 
    Set VSFData = Sheets("VSF_DATASHEET") 

    With CrisData             'Unlock spreadsheets 
     .Unprotect Password:="pass" 
     .Cells.Locked = False 
    End With 

    With DEAMSData 
     .Unprotect Password:="pass" 
     .Cells.Locked = False 
    End With 
    With VSFData 
     .Unprotect Password:="pass" 
     .Cells.Locked = False 
    End With 
    With Sheets("HOME") 
     .Unprotect Password:="pass" 
     .Cells.Locked = False 
    End With 

    Sheets("HOME").Select 
    Sheets("HOME").Cells(26, 6).Value = "Sheet is Unlocked" 

End Sub 

Public Function GetData(loc As Integer) As Integer 

    Application.Calculation = xlCalculationManual 

    Dim raw As Workbook, ThisBook As Workbook 
    Dim fileName 

    'Opens the data sheet from which to work from 

    Set ThisBook = ThisWorkbook 

    If loc = 0 Then 
     MsgBox ("Please select DEAM's Discoverer Viewer export") 
     'Get the DEAMS File 
     fileName = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", _ 
     , "Please select DEAM's Discoverer Viewer STATUS_OF_FUNDS Excel Output") 
     If fileName = False Then 
      GetData = 1 
      Exit Function 
     End If 
     Set raw = Workbooks.Open(fileName) 
     raw.Sheets(1).Cells(1, 1).EntireRow.Delete 
     raw.Sheets(1).Cells(1, 1).EntireRow.Delete 
    Else 
     MsgBox ("Please select CRIS export") 
     'Get the CRIS File 
     fileName = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", _ 
     , "Please select CRIS export") 
     If fileName = False Then 
      GetData = 1 
      Exit Function 
     End If 
     Set raw = Workbooks.Open(fileName) 
    End If 



    If loc = 0 Then 
    ThisBook.Sheets("DEAMS_DATASHEET").Range("A:V").Value = raw.Sheets(1).Range("A:V").Value 

    Else 
    Application.CutCopyMode = False 
    raw.Sheets(1).ListObjects("Table1").Unlist 
    raw.Sheets(1).Range("A:Z").ClearFormats 
    ThisBook.Sheets("CRIS_DATASHEET").Range("A:X").Value = raw.Sheets(1).Range("A:X").Value 

    End If 

    raw.Close SaveChanges:=False 
    Application.CutCopyMode = False 

    Set ThisBook = Nothing 
    Set raw = Nothing 
    GetDeamsData = 0 

End Function 

Answer 1

Помнить Из памяти означает, что для какой-либо структуры/объекта/предмета недостаточно свободной памяти. Это не означает, что нет свободной памяти или даже большой свободной памяти, просто не в достаточно большом блоке. Поэтому посмотрите на данные, которые у вас большие.

Также я предполагаю, что этот код запускается изнутри excel. Подумайте о том, чтобы принять его в vbscript или VB6. Затем каждое техническое описание может жить в собственном процессе (тогда у каждого набора данных будет много места для хранения в памяти), поскольку вызовы будут неработоспособны. Это медленно.

Я бы предположил, что ваш процесс неисправен. Вы открываете в то же время много вещей.