Question

我试图将大量行（20k到65k）复制到新工作簿中，并且出于某种原因，分配复制范围的值比使用复制/使用更多内存粘贴缓冲区，对我没有任何意义，除非我以某种方式做错了。

这是原始代码：

Public Const FIRSTSHEETTAB As String = "Sheet1"
' <snip>

Dim last_row As Long
Dim num_files As Long
Dim ps_rng As Range
' <snip>

Dim i As Long
Dim new_book As Workbook
Dim start_row As Long
Dim end_row
start_row = 2
For i = 1 To num_files
    Set new_book = Workbooks.Add
    end_row = start_row + max_lines - 1
    If end_row > last_row Then
        end_row = last_row
    End If
    With new_book
        .Windows(1).Caption = "PS Upload " & i
        With .Worksheets(FIRSTSHEETTAB)
            .Range("1:1").Value2 = ps_rng.Range("1:1").Value2
            .Range("2:" & max_lines).Value2 = ps_rng.Range(CStr(start_row) & ":" & CStr(end_row)).Value2
        End With
    End With
    start_row = end_row + 1
Next i

我需要做的就是将.Range("2:" & max_lines).Value2 = ps_rng.Range(CStr(start_row) & ":" & CStr(end_row)).Value2更改为以下内容：

ps_rng.Range(CStr(start_row) & ":" & CStr(end_row)).Copy
.Range("2:" & max_lines).PasteSpecial

而且我不明白为什么这会因为前代码耗尽内存而起作用。如果我能帮忙的话，我更不必覆盖复制/粘贴缓冲区中的任何内容。

导致内存耗尽的原因是什么？

Answer 1

当您使用Copy时，Excel非常智能，只能复制复制范围的已用部分。

EG。看下面：授予这个是查看剪贴板上的“文本”版本，但这正是你PasteSpecial

时得到的结果

Sub Tester()

    ActiveSheet.Cells.ClearContents
    ActiveSheet.UsedRange 'reset sheet
    CheckCopy '>> 1

    ActiveSheet.Range("A1:J1").Value = "x"
    CheckCopy '>> 10

    ActiveSheet.Range("XFD1").Value = "x"
    CheckCopy '>> 16384

    ActiveSheet.Range("XFD1").ClearContents
    CheckCopy '>> 16384

    ActiveSheet.UsedRange 'reset sheet
    CheckCopy '>> 10

End Sub

Sub CheckCopy()
    Dim d As New DataObject, s As String
    ActiveSheet.Rows(1).Copy
    d.GetFromClipboard
    s = d.GetText
    Debug.Print "#Cols: " & IIf(Len(s) = 0, 0, UBound(Split(s, vbTab)) + 1)
End Sub

直接在两个大范围之间分配Value时，您无法获得此优化。

Answer 2

因为您同时分配了16.384 x 65.000 = 1.064.960.000单元格的值，这对Excel来说太过分了。

更好的方法是使用具有值的最后一列来限制要复制的所需范围。我不建议使用UsedRange属性，因为它有时会在很久以前编辑远处的单元格时产生一些不需要的结果。

下面是一个代码示例：

Public Const FIRSTSHEETTAB As String = "Sheet1"
' <snip>

Dim last_row As Long
Dim num_files As Long
Dim ps_rng As Range
' <snip>

Dim i As Long
Dim new_book As Workbook
Dim start_row As Long
Dim end_row
start_row = 2
'Obtaining last column of the desired range
lastColumn = ps_rng.Cells(1, ps_rng.Columns.Count).End(xlToLeft).Column


For i = 1 To num_files
    Set new_book = Workbooks.Add
    end_row = start_row + max_lines - 1
    If end_row > last_row Then
        end_row = last_row
    End If
    With new_book
        .Windows(1).Caption = "PS Upload " & i
        With .Worksheets(FIRSTSHEETTAB)
            .Range(.Cells(1, 1), .Cells(1, lastColumn)).Value2 = ps_rng.Range(ps_rng.Cells(1, 1), ps_rng.Cells(1, lastColumn)).Value2
            .Range(.Cells(2, 1), .Cells(max_lines, lastColumn)).Value2 = ps_rng.Range(ps_rng.Cells(start_row, 1), ps_rng.Cells(end_row, lastColumn)).Value2
        End With
    End With
    start_row = end_row + 1
Next i

Excel VBA内存使用情况

2 个答案: