Excel не хватает памяти при копировании строк с .rows (y) .value = .rows (x) .value

Question

В основном я хочу скопировать определенные строки на другой лист. Для этого я использую эти строки в al oop:

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 - это количество строк в моем листе,

Я просто хочу, чтобы строки выпали в остальное скопировано на новый лист.

Так как я делаю только .Value = .Value, я не совсем понимаю, как он вообще использует ram, так как я думал, что .Value = .Value буквально использует только ram для этой строки и немедленно получает сборщик мусора.

Код работает с i от 2 до 100, но данные, с которыми я работаю, имеют ~ 23000 строк. И после примерно 21000 строк у меня кончается память для 32-битного Excel.

Использование 64-битного Excel не подходит для банкоматов.

Answer 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

Answer 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

Если нет необходимости копировать в «А1», его легко адаптировать ...

Answer 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