使用 .rows(y).value = .rows(x).value 复制行时，Excel 内存不足答案

【问题标题】：Excel is running out memory when copying rows with .rows(y).value = .rows(x).value使用 .rows(y).value = .rows(x).value 复制行时，Excel 内存不足
【发布时间】：2020-07-12 01:32:27
【问题描述】：

基本上我想将某些行复制到另一个工作表。为此，我在循环中使用这些行：

For i = 2 To lRow
    Select Case ws.Cells(i, 1).Value
        Case "00"
        Case "01"
        Case "02"
        Case "03"
        Case Else
            wsNew.Rows(rowCounter).Value = ws.Rows(i).Value
            rowCounter = rowCounter + 1
    End Select
Next i

在此之前是一个只复制某些行的大选择语句。 ws 是我的原始工作表， wsNew 是我的新工作表和 rowCounter 只是一个帮手知道我填写了多少 wsNew lRow 是我的工作表中的行数，

我只想将属于 else 的行复制到新工作表中。

由于我只做 .Value = .Value 我根本不明白它是如何使用 ram 的，因为我认为 .Value = .Value 实际上只在该行中使用 ram 并立即被垃圾收集。

代码适用于从 2 到 100 的 i，但我正在使用的数据有 ~23000 行。在大约 21000 行之后，我用完了 32 位 excel 的内存。

使用 64 位 excel 不是一个选项 atm。

【问题讨论】：

i、lRow 和 rowCounter 声明为什么？
展示您的“大选择语句”以及如何制作“某些行”的副本。
不要复制整行 - 只复制到最后一列。
我添加了我的选择语句，我仍然不明白 wsNew.Rows(rowCounter).Value = ws.Rows(i).Value 是如何使用任何内存的。没有这条线，它可以完美地工作，而无需使用更多的内存，而不仅仅是打开工作簿。
不要在循环中复制/粘贴。使用过滤器或联合，以便您可以一次复制/粘贴所有内容。

标签： excel vba

【解决方案1】：

我几乎 100% 确定您不需要复制整个 excel 行 - 包括所有可能的列，甚至是空白列。

试一试：

For i = 2 To lRow
    Select Case ws.Cells(i, 1).Value
        Case "00"
        Case "01"
        Case "02"
        Case "03"
        Case Else
            Dim lastColumn as Long
            lastColumn = ws.Cells(i,ws.Columns.Count).End(xlToLeft).Column
            wsNew.Cells(rowCounter,1).Resize(1,lastColumn).Value = ws.Cells(i,1).Resize(1,lastColumn).Value
            rowCounter = rowCounter + 1
    End Select
Next i

【讨论】：

哇，天真的我以为 Excel 只会复制使用过的单元格。好的，谢谢，解决了。
@Barbarian772 - 太好了。很高兴它奏效了。正如您所知，将所有值加载到一个范围内会更快更有效 - 在循环内使用联合 - 然后在最后写入一次范围。需要编写更多代码，但在大多数极端情况下，这绝对是可行的方法。

【解决方案2】：

请也试试这个代码。它应该很快：

Sub testRowsCopyOtherSheet()
 Dim ws As Worksheet, wsNew As Worksheet, rng As Range, rngUR As Range
 Dim i As Long, lRow As Long
 Set ws = ActiveSheet 'use here your sheet
 Set wsNew = Worksheets("Sheet25")'use here your sheet (I used it for testing)
 Set rngUR = ws.UsedRange
 lRow = ws.UsedRange.Rows.Count

 For i = 2 To lRow
    Select Case ws.Cells(i, 1).value
        Case "00"
        Case "01"
        Case "02"
        Case "03"
        Case Else
            If Not rng Is Nothing Then                    
                Set rng = Union(rng, Intersect(rngUR, ws.Rows(i)))
            Else
                Set rng = Intersect(rngUR, ws.Rows(i))
            End If
    End Select
 Next i
 wsNew.Range("A1").Resize(rng.Rows.Count, rng.Columns.Count).value = rng.value
End Sub

如果不需要在“A1”中复制，很容易适应...

【讨论】：

【解决方案3】：

您可以使用Autofilter() 进行一次性复制粘贴：

Dim unWantedRng As Range
With ws
    With .Range("Z1", .Cells(.Rows.Count, 1).End(xlUp)) '<-- change "Z" to whatever column name has the last one of yuor database
        .AutoFilter Field:=1, Criteria1:=Array("00", "01", "02", "03"), Operator:=xlFilterValues
        Set unWantedRng = .SpecialCells(xlCellTypeVisible)
        .Parent.AutoFilterMode = False

        unWantedRng.EntireRow.RowHeight = 0

        .SpecialCells(xlCellTypeVisible).Copy Destination:=wsNew.Range("A1")
        rowCounter = ws.Cells(Rows.Count, 1).End(xlUp).Row

        unWantedRng.EntireRow.Hidden = False
    End With
End With

【讨论】：