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的第一个单元格，我就会收到错误消息＆＃34;运行时错误7，系统内存不足＆＃34;但我仍然有2GB的内存，所以这似乎不是你的memyc问题，我需要关闭一些应用程序，它会运行，因为它只是没有。我想知道我的代码是否有问题？

代码看起来的一些示例值是：

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

Excel VBA耗尽内存，但内存充足

1 个答案: