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