Excel VBA работает из памяти, но есть много памяти

Question

у меня есть этот код:

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 

код работает отлично для Statement части IF, которая является простой полицейский и вставить такой сценарий, но то, как только WS был скопирован в новый WB, мне нужен столбец 3, чтобы разделить любую ячейку, которая больше 1M на 1M, и как только код найдет первую ячейку со значением более 1M, я получаю сообщение об ошибке «Runtime Error 7, система из памяти ", но у меня все еще есть 2 ГБ слева от памяти, поэтому это не похоже на то, что вы не можете решить проблему, когда мне нужно закрыть несколько приложений, и она будет работать, потому что она просто не работает. Мне интересно, есть ли проблема с моим кодом?

некоторые из значений выборок, что код будет выглядеть являются:

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