Excel VBA内存不足，但内存充足

我有这个代码：

Sub reportCreation() Dim sourceFile As Variant Dim wbSource As Workbook Dim wbDest As Workbook Dim sourceSheet As Worksheet Dim destSheet As Worksheet Dim rng As Range Dim i As Long Dim NValues As Long If sourceFile = False Then MsgBox ("Select the MyStats file that you want to import to this report") sourceFile = Application.GetOpenFilename Set wbSource = Workbooks.Open(sourceFile) Set sourceSheet = wbSource.Sheets("Test Dummy Sheet") Set rng = sourceSheet.Range("A:N") rng.Copy Set wbDest = ThisWorkbook Set destSheet = wbDest.Sheets("MyStats") destSheet.Range("A1").PasteSpecial Application.CutCopyMode = False wbSource.Close End If NValues = destSheet.Cells(destSheet.Rows.Count, 2).End(xlUp).Row With destSheet For i = 6 To NValues ' Cells(i, 3).NumberFormat = "0" With Cells(i, 3) .Value = Cells.Value / 1000000 .NumberFormat = "0.00" End With Next i End With End Sub 

代码运行良好的IF语句部分这是一个简单的缔约方会议和粘贴sorting的情况下，但是一旦WS已经复制到新的WB我需要列3分配任何单元格是大于1M由1M和尽快作为代码find值超过1M的第一个单元格我得到一个错误消息“运行时错误7，系统内存不足”，但我仍然有2GB的内存，所以这似乎不是你的tipycal出内存问题我需要closures几个应用程序，它会运行，因为它没有。 我想知道如果有我的代码问题？

代码的一些示例值是：

 16000000 220000 2048000 230000 16000000 230000 16000000 

Answer 1

你可能想要采取不同的方法如下（见评论）

 Option Explicit Sub reportCreation() Dim sourceFile As Variant Dim sourceSheet As Worksheet Dim tempCell As Range sourceFile = Application.GetOpenFilename(Title:="Select the MyStats file that you want to import to this report", _ FileFilter:="Excel Files *.xls* (*.xls*),") '<-- force user to select only excel format files If sourceFile = False Then Exit Sub '<-- exit if no file selected Set sourceSheet = TryGetWorkSheet(CStr(sourceFile), "Test Dummy Sheet") '<-- try and get the wanted worksheet reference in the chosen workbook If sourceSheet Is Nothing Then Exit Sub '<-- exit if selected file has no "Test Dummy Sheet" sheet With sourceSheet '<-- reference your "source" worksheet Intersect(.UsedRange, .Range("A:N")).Copy End With With ThisWorkbook.Sheets("MyStats") '<-- reference your "destination" worksheet .Range("A1").PasteSpecial Application.CutCopyMode = False sourceSheet.Parent.Close Set tempCell = .UsedRange.Cells(.UsedRange.Rows.Count + 1, .UsedRange.Columns.Count) '<-- get a "temporary" cell not in referenced worksheet usedrange tempCell.Value = 1000000 'set its value to the wanted divider tempCell.Copy ' get that value into clipboard With .Range("C6:C" & .Cells(.Rows.Count, 2).End(xlUp).Row) '<-- reference cells in column "C" from row 6 down to last not empty one in column "B" .PasteSpecial Paste:=xlValues, Operation:=xlPasteSpecialOperationDivide '<-- divide their values by clipboard content .NumberFormat = "0.00" '<-- set their numberformat End With tempCell.ClearContents '<-- clear the temporary cell End With End Sub Function TryGetWorkSheet(wbFullName As String, shtName As String) As Worksheet On Error Resume Next Set TryGetWorkSheet = Workbooks.Open(wbFullName).Sheets("Test Dummy Sheet") End Function