excel - 如何清除内存以防止内存错误？

Question

我有一个宏，它遍历切片器中的 12 个项目，复制一个大型数据透视表(约 400k 行)并将值每次粘贴到单独的工作表中。
当我手动执行此操作时，它可以工作 .但是，当宏运行时，它会到达第 11 项并崩溃，说“内存不足”。
我尝试从可能包含大量数据的变量中清除值(下面的 Range1)。
有没有办法清除临时内存？我不明白手动过程是如何工作的，但宏中的同样事情会产生内存错误。

Sub EIMonthlyHarvest()
Dim CurrentWorkbookName As String
Dim TargetWorkbookName As String
Dim TargetSheetName As String
Dim i As Long
Dim Range1 As Range
Dim Months() As Variant

Months = Array("JAN", "FEB", "MAR", "APR", "MAY", "JUN", "JUL", "AUG", "SEP", "OCT", "NOV", "DEC")

'Set up target book
CurrentWorkbookName = ActiveWorkbook.Name

Workbooks.Add
TargetWorkbookName = ActiveWorkbook.Name
Sheets("Sheet1").Select
Sheets("Sheet1").Name = "JAN"
Sheets.Add After:=ActiveSheet
Sheets("Sheet2").Select
Sheets("Sheet2").Name = "FEB"
Sheets.Add After:=ActiveSheet
Sheets("Sheet3").Select
Sheets("Sheet3").Name = "MAR"
Sheets.Add After:=ActiveSheet
Sheets("Sheet4").Select
Sheets("Sheet4").Name = "APR"
Sheets.Add After:=ActiveSheet
Sheets("Sheet5").Select
Sheets("Sheet5").Name = "MAY"
Sheets.Add After:=ActiveSheet
Sheets("Sheet6").Select
Sheets("Sheet6").Name = "JUN"
Sheets.Add After:=ActiveSheet
Sheets("Sheet7").Select
Sheets("Sheet7").Name = "JUL"
Sheets.Add After:=ActiveSheet
Sheets("Sheet8").Select
Sheets("Sheet8").Name = "AUG"
Sheets.Add After:=ActiveSheet
Sheets("Sheet9").Select
Sheets("Sheet9").Name = "SEP"
Sheets.Add After:=ActiveSheet
Sheets("Sheet10").Select
Sheets("Sheet10").Name = "OCT"
Sheets.Add After:=ActiveSheet
Sheets("Sheet11").Select
Sheets("Sheet11").Name = "NOV"
Sheets.Add After:=ActiveSheet
Sheets("Sheet12").Select
Sheets("Sheet12").Name = "DEC"

'Start of month loop
For i = 1 To 12
    
    TargetSheetName = Months(i - 1)
    Windows(CurrentWorkbookName).Activate 
    
    ActiveWorkbook.SlicerCaches("Slicer_modMonth").VisibleSlicerItemsList = _
      Array( _
      "[Query].[modMonth].&[" & i & "]")
        
    'Copy and paste values fast
    Set Range1 = Range("B:M")

    Windows(TargetWorkbookName).Activate
    Sheets(TargetSheetName).Activate
    Range("A1").Resize(Range1.Rows.Count, Range1.Columns.Count).Cells.Value = Range1.Cells.Value
    Set Range1 = Nothing

Next i

End Sub

编辑 :
我找到了一种解决方法 - 在中途保存 TargetWorkbook。这意味着将在临时保存文件夹中堆积较小的文件。
有没有更优雅的想法？

Sub EIMonthlyHarvest()
Dim CurrentWorkbookName As String
Dim TargetWorkbookName As String
Dim TargetSheetName As String
Dim i As Long
Dim Range1 As Range
Dim Months() As Variant

Months = Array("JAN", "FEB", "MAR", "APR", "MAY", "JUN", "JUL", "AUG", "SEP", "OCT", "NOV", "DEC")

'Set up target book
CurrentWorkbookName = ActiveWorkbook.Name

Workbooks.Add
TargetWorkbookName = ActiveWorkbook.Name
Sheets("Sheet1").Select
Sheets("Sheet1").Name = "JAN"
Sheets.Add After:=ActiveSheet
Sheets("Sheet2").Select
Sheets("Sheet2").Name = "FEB"
Sheets.Add After:=ActiveSheet
Sheets("Sheet3").Select
Sheets("Sheet3").Name = "MAR"
Sheets.Add After:=ActiveSheet
Sheets("Sheet4").Select
Sheets("Sheet4").Name = "APR"
Sheets.Add After:=ActiveSheet
Sheets("Sheet5").Select
Sheets("Sheet5").Name = "MAY"
Sheets.Add After:=ActiveSheet
Sheets("Sheet6").Select
Sheets("Sheet6").Name = "JUN"
Sheets.Add After:=ActiveSheet
Sheets("Sheet7").Select
Sheets("Sheet7").Name = "JUL"
Sheets.Add After:=ActiveSheet
Sheets("Sheet8").Select
Sheets("Sheet8").Name = "AUG"
Sheets.Add After:=ActiveSheet
Sheets("Sheet9").Select
Sheets("Sheet9").Name = "SEP"
Sheets.Add After:=ActiveSheet
Sheets("Sheet10").Select
Sheets("Sheet10").Name = "OCT"
Sheets.Add After:=ActiveSheet
Sheets("Sheet11").Select
Sheets("Sheet11").Name = "NOV"
Sheets.Add After:=ActiveSheet
Sheets("Sheet12").Select
Sheets("Sheet12").Name = "DEC"
  
'Start of month loop
For i = 1 To 12

    If i = 6 Then
        ActiveWorkbook.Save
    End If
  
    TargetSheetName = Months(i - 1)
    Windows(CurrentWorkbookName).Activate
    
    ActiveWorkbook.SlicerCaches("Slicer_modMonth").VisibleSlicerItemsList = _
        Array( _
        "[Query].[modMonth].&[" & i & "]")
        
    Set Range1 = Range("B:M")

    Windows(TargetWorkbookName).Activate
    Sheets(TargetSheetName).Activate
    Range("A1").Resize(Range1.Rows.Count, Range1.Columns.Count).Cells.Value = Range1.Cells.Value
    Set Range1 = Nothing
    
Next i
  
End Sub

Answer 1

请尝试下一个改编代码:

Sub EIMonthlyHarvest()
 Dim i As Long, lastRow As Long, k As Long
 Dim Range1 As Range, Months() As Variant
 Dim wbAct As Workbook, wbCur As Workbook, sh As Worksheet

 Months = Array("JAN", "FEB", "MAR", "APR", "MAY", "JUN", "JUL", "AUG", "SEP", "OCT", "NOV", "DEC")

 Set wbCur = ActiveWorkbook
 Set wbAct = Workbooks.Add

 For Each sh In wbAct.Sheets
    sh.Name = Months(k): k = k + 1 'give name to the existing sheets
 Next
 For i = k To UBound(Months)
    wbAct.Sheets.Add(After:=wbAct.Sheets(wbAct.Sheets.count)).Name = Months(i) 'give names to the newly added sheets
 Next i

 For i = 1 To 12
    wbCur.SlicerCaches("Slicer_modMonth").VisibleSlicerItemsList = _
                            Array("[Query].[modMonth].&[" & i & "]")
    lastRow = wbCur.UsedRange.rows.count + wbCur.UsedRange.row 'last row
        
    'Copy and paste values fast
    Set Range1 = wbCur.Range("B1:M" & lastRow) 'the range up to the last row
    'drop the range value
    wbAct.Sheets(Months(i - 1)).Range("A1").Resize(Range1.rows.count, _
                 Range1.Columns.count).cells.Value = Range1.cells.Value
    DoEvents
 Next i
End Sub