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

該代碼在IF語句部分運行良好，這是一種簡單的復制粘貼方案，但是一旦將WS復制到新的WB中，我就需要第3列來指定大於1M乘以1M的任何單元，並盡快當代碼找到第一個單元格的值超過1M時，我收到一條錯誤消息“運行時錯誤7，系統內存不足”，但我還有2GB的內存空間，所以這似乎不是您的內存不足問題，其中我需要關閉一些應用程序，它會運行，因為它不會。 我想知道我的代碼是否有問題？

該代碼將顯示一些示例值：

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