Excel VBA内存不足

Excel VBA内存不足,excel,vba,Excel,Vba,我从内存中获取Excel VBA 007错误。我正在利用效率来清除剪贴板、内存、内存使用限制,并且在第二次调用GetData(integer)函数时仍然可以在该函数中获取它。有什么想法吗?我被迫在我的政府电脑上运行32位 Sub RunStatusOfFunds() 'Declare worksheet variables Dim HOME As Worksheet Dim CRIS_CRITERIA_DATASHEET As Worksheet Dim DEA

我从内存中获取Excel VBA 007错误。我正在利用效率来清除剪贴板、内存、内存使用限制,并且在第二次调用GetData(integer)函数时仍然可以在该函数中获取它。有什么想法吗?我被迫在我的政府电脑上运行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

记忆不足意味着没有足够的连续内存来存储某些结构/对象/事物。这并不意味着没有可用内存,甚至没有很多可用内存,只是块不够大。因此,请查看您拥有的大量数据

我还认为这段代码是从excel内部运行的。考虑将其放入vbscript或VB6中。然后,每个数据表都可以存在于自己的进程中(然后每个数据表都有大量的内存空间可以容纳),因为调用将脱离进程。这太慢了


我想你的工艺设计是有缺陷的。您同时打开了很多东西。

请参阅。你粘贴了一堵“代码墙”,没有人可以复制它而不从头构建一个多工作表工作簿。你还包括密码-这明智吗(特别是对于USAF)?这是不安全的数据。密码只是为了不让任何人弄乱工作表。我添加了“代码墙”,因为之前的错误7帖子建议需要查看“整体情况”进行评估。谢谢你让我走出内存不足错误的迷雾。我想知道,即使是32位,我是如何占用1.3gb内存的。