Question

我真的希望我能解决这个问题，但没有任何运气。以下VBA允许用户从单独的文件导入数据，并确定要由单个命令按钮启动的要分析的唯一变量。调用最终子时会发生此问题（过滤唯一变量）。我已设置.ScreenUpdating = false并在使用后将变量设置为null。对于工作簿中的工作表，它们当前不包含数据或公式，但需要进一步分析数据。

任何有助于识别大量内存使用的帮助都将受到赞赏。

64位遗憾的是不是一个选项

位于第1单元：

    Global PathAndFile As String
    Global FileName As String
 Sub SelectFile()

Application.ScreenUpdating = False
 Dim fd As FileDialog
 Dim InDir As String
 Dim wb As Workbook

 InDir = CurDir()   'Save current directory

 Set fd = Application.FileDialog(msoFileDialogFilePicker)

 With fd
     .InitialFileName = CurDir & "\"     'Startup folder
     .AllowMultiSelect = False
     .Filters.Clear
     .Filters.Add "All Excel Files", "*.csv" 'Display csv files only

     If .Show = False Then
         MsgBox "User canceled without selecting."
         ChDir (InDir)  'Change back to Initial directory if user cancels
         Exit Sub
     End If
     'contains the path and filename of selected file
     PathAndFile = .SelectedItems(1)
 End With

 'contains the filename (without the path)
 FileName = Right(PathAndFile, Len(PathAndFile) - _
         InStrRev(PathAndFile, "\"))

 'Clear storage sheet
 ThisWorkbook.Worksheets("DataTransferred").Cells.Clear
 Call rData
 End Sub

Sub rData()
'Retrieve Data
Dim lRow As Long
Dim lCol As Long
Dim Datawb As Workbook

'Open Selected workbook
Set Datawb = Workbooks.Open(PathAndFile)

    With Datawb
    'Find the last non-blank cell in column A(1)
    lRow = Cells(Rows.Count, 1).End(xlUp).Row

    'Find the last non-blank cell in row 1
    lCol = Cells(1, Columns.Count).End(xlToLeft).Column

    'Copy data and paste in new this workbook
    Range(Cells(1, 1), Cells(lRow, lCol)).Copy _
    Destination:=ThisWorkbook.Worksheets("DataTransferred").Cells(1, 1)

    End With

Workbooks(FileName).Close


'Clear Memory
lRow = 0
lCol = 0
strPathAndFile = vbNullString
strFileName = vbNullString
'Sort data
Call Worksheets("DataTransferred").VariableSelect '<<<Run-Time Error 7
Application.ScreenUpdating = True
End Sub

位于表格（“DataTransffered”）：

Sub VariableSelect()
'Determine unique variables out of assortment
    Dim rngDest As Range

    If ThisWorkbook.Worksheets("DataTransferred").Cells = Empty Then Exit Sub

        'Determine destination for varilables
        Set rngDest = ThisWorkbook.Sheets("Analysis").Range("A1")
            rngDest.ClearContents
        'Select cells with in column (B) and apply filter
        Me.Range(Me.Range("B1"), Me.Cells(Rows.Count, 2).End(xlUp)).AdvancedFilter _
        Action:=xlFilterCopy, CopyToRange:=rngDest, Unique:=True


End Sub

还有哪些其他方法可以减少VBA中的内存使用量？ 32位Excel

0 个答案: