關閉工作簿時出現 memory 錯誤 - 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 編輯器收到“內存不足”錯誤消息。 幫助鏈接將您帶到這里：

超出 memory（錯誤 7）

我已經嘗試了此頁面上的許多解決方案，但除了注釋掉關閉外部工作簿的代碼行之外似乎沒有什么可以阻止錯誤：

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

有誰知道為什么 Excel 在這里與 memory 斗爭？ 外部工作簿只有 216Kb，而運行代碼的工作簿是 6.3Mb。 在其他宏中，我經常毫無問題地進出其他工作簿。

更新：將外部工作簿保存和使用為 a.xlsx 文件似乎也可以解決問題。 不是一個總數，因為外部確實需要是.xlsm，但至少它是……

更新：在初始化用戶表單之前關閉 VBA 編輯器也解決了 memory 問題......不知道為什么：

ThisWorkbook.VBProject.VBE.MainWindow.Visible = False

Answer 1

對我來說，這個問題是由於關閉工作簿時隱藏用戶 forms 但未卸載造成的。 我將以下代碼添加到工作簿模塊：

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

這解決了我的問題。