excel - 如何清除内存以防止内存错误?
问题描述
我有一个宏,它循环遍历切片器中的 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
解决方案
请尝试下一个改编代码:
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
推荐阅读
- r - 检查 R 向量中的序列
- java - 如何执行 OpenJDK 调试包
- html - 移动 Safari 浏览器的问题
- c# - “没有给出与所需形式参数相对应的参数” - 尝试测试 OOP 继承时
- tensorflow - 在带有 TF2 后端的 Keras 中实现的 LSTM 的损失保持不变,并且在大型数据集上训练时基本不会学习参数
- android - 在 NavDrawer 中按下项目时执行代码
- javascript - Create-react-app 没有在 iOS 上加载 JavaScript?
- python - git private repo 上的碰撞版本,现在安装要求失败
- python - 当我单击按钮时,它不会将数据写入变量
- sql - 特定部分的 SQL 运行总计