excel - 关闭工作簿时出现内存不足错误 - Excel VBA

Question

我正在使用带有几个下拉组合框的用户窗体将数据从外部工作簿拉入此工作簿。

外部工作在 Userform_Initialise 宏中打开并填充组合框:

Sub UserForm_Initialize()

    'Open criteria database
    Dim X As String
    X = ThisWorkbook.path

    Workbooks.Open FileName:=X & "\Criteria database.xlsm"

    'Number of non-unique clients in DB
    Dim noClients As Integer
    noClients = Application.WorksheetFunction.CountA(Workbooks("Criteria database").Sheets("Screen decisions").Range("A:A")) - 1

    'define array for client names
    Dim clientArray() As String
    Dim j As Integer: j = 1
    ReDim clientArray(1 To noClients)

    'populate array of non-unique clients
    Do Until j = noClients + 1
        clientArray(j) = Workbooks("Criteria database").Sheets("Screen decisions").Range("A" & j + 1).value
        j = j + 1
    Loop

    'Now that we have non-unique clients, remove those that are duplicates
    Dim uClients As New Collection, a
    Dim i As Long

    'Adds only unique collections
    On Error Resume Next
    For Each a In clientArray
       uClients.Add a, a
    Next

    For Each a In uClients
        clientBox.AddItem a
    Next

    'Memory handling
    Set uClients = Nothing
    Erase clientArray()

End Sub

当用户从组合框中进行选择时，工作簿保持打开状态。选择后，从打开的工作簿中拖入相关数据，然后关闭工作簿:

Sub OK_Click()

    Me.Hide

    'define sheets
    Dim sd As Worksheet
    Set sd = Workbooks("Criteria database").Sheets("Screen decisions")

    Dim lt As Worksheet
    Set lt = Workbooks("Criteria database").Sheets("Lookup table")

    Dim cc As Worksheet
    Set cc = ThisWorkbook.Sheets("Current client")

    cc.Range("A5:BZ50").ClearContents 'clear current client data

    'find current client and portfolio row
    Dim curC As String
    curC = clientBox.value

    Dim curP As String
    curP = portfolioBox.value

    Dim lrow As Integer
    lrow = sd.Cells(sd.Rows.count, 1).End(xlUp).row

    Dim i, j As Integer
    Dim a As Integer 
    Dim nm As Name 'Current named range
    Dim nmstr As String 'string name of range
    Dim topRng As Range 'Top row range
    Dim col As Integer 'first column in range
    Dim crit As Range 'used to loop through cells in current range
    Dim c As Integer: c = 2 'Keeps track of current client column
    Dim r As Integer 'Keeps track of current client row
    Dim critCol As Integer 'current criteria screening value
    Dim tRow As Integer 'lookup table row in criteria database

    For i = 2 To lrow

        'Stop when we get to the correct position
        If sd.Cells(i, 1).value = curC And sd.Cells(i, 2).value = curP Then

            For Each nm In Workbooks("Criteria database").Names 'Looping through the named ranges

                nmstr = Right(nm.RefersTo, Len(nm.RefersTo) - 19)
                nmstr = Replace(nmstr, "$", "")
                Set topRng = sd.Range(nmstr)
                col = topRng.Column 'First column in range

                If sd.Cells(i, col).value <> "None" Then 'If 1st criteria isn't "None" then it is in use

                    tRow = Application.Match(nm.Name, lt.Range("A:A"), 0)
                    cc.Cells(5, c).value = lt.Cells(tRow, 3).value 'lock in formatted named range
                    r = 6 'reset row

                    For Each crit In topRng

                        cc.Cells(r, c).Value2 = crit.Value2
                        critCol = crit.Column
                        cc.Cells(r, c + 1).Value2 = sd.Cells(i, critCol).Value2
                        r = r + 1

                    Next crit

                    c = c + 2

                End If

            Next nm

            Exit For

        End If

    Next i


    Set sd = Nothing
    Set lt = Nothing
    cc.Activate
    Set cc = Nothing
    Set topRng = Nothing

    Workbooks("Criteria database").Close SaveChanges:=False 'PROBLEM LINE

    Unload Me

End Sub

当您按上面的方式运行此代码时，我从 VBA 编辑器中收到“内存不足”错误消息。帮助链接将您带到此处:

Out of memory (Error 7)

我已经尝试了此页面上的许多解决方案，但除了注释掉关闭外部工作簿的代码行之外，似乎没有什么可以阻止错误:

'Workbooks("Criteria database").Close SaveChanges:=False 'PROBLEM LINE

有谁知道为什么 Excel 在这里与内存作斗争？外部工作簿只有 216Kb，而运行代码的工作簿有 6.3Mb。在其他宏中，我经常毫无问题地跳入和跳出其他工作簿。

更新:将外部工作簿另存为 .xlsx 文件似乎也可以解决问题。不是全部，因为外部确实需要是 .xlsm，但至少它是某种东西......

更新:在初始化用户窗体之前关闭 VBA 编辑器也解决了内存问题...不知道为什么:

ThisWorkbook.VBProject.VBE.MainWindow.Visible = False

Answer 1

对我来说，这个问题是由于在关闭工作簿时隐藏但未卸载用户表单造成的。我在工作簿模块中添加了以下代码:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
  'close any open forms
  Do While UserForms.Count > 0
    Unload UserForms(0)
  Loop
End Sub

这解决了我的问题。