エクセル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 

コードは、シナリオの簡単な警官とペースト一種であるIF文部分の細かい動作しますが、その後いったんWSは新しいWBにコピーされました。私は1Mよりも大きい任意のセルを分けるためにカラム3を必要とします。そして、コードが最初のセルを1M以上の値で見つけたら、エラーメッセージ "ランタイムエラー7"私はいくつかのアプリケーションを終了する必要があり、ちょうどそれがないので実行されますmemの問題のあなたのtipycalのようではないように私はまだ2GBのメモリが残っているので、 私のコードに問題があるのでしょうか？

コードを見ていきますサンプル値のいくつかは以下のとおりです。

16000000 
220000 
2048000 
230000 
16000000 
230000 
16000000 

Answer 1

あなたは次のように異なるアプローチを採用することもできます（コメントを参照してください） `.Valueの=細胞における

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