Question

我收到内存007错误的Excel VBA。我使用效率来清除剪贴板，内存，内存使用限制，并且在第二次调用它时仍然可以在我的GetData（整数）函数上获取它。有任何想法吗？我被迫在我的政府电脑上运行32位。

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。然后，每个数据表都可以存在于它自己的进程中（然后每个数据表都有大量的内存空间可供使用），因为调用将不在进程中。这很慢。

我想你的工艺设计是错误的。你正在同时开放很多东西。

Excel VBA内存不足

1 个答案: