Zasadniczo chcę skopiować określone wiersze do innego arkusza roboczego. W tym celu używam tych linii w pętli:

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

Wcześniej jest to duża instrukcja select, która kopiuje tylko niektóre wiersze. ws to mój oryginalny arkusz roboczy, wsNew to mój nowy arkusz, a rowCounter jest tylko pomocnikiem, który pomaga wiedzieć, ile wypełniłem wsNew lRow to liczba wierszy w moim arkuszu,

Chcę tylko, aby wiersze, które należą do innego, zostały skopiowane do nowego arkusza.

Ponieważ robię tylko .Value = .Value, tak naprawdę nie rozumiem, jak w ogóle używa pamięci RAM, ponieważ pomyślałem, że .Value = .Value dosłownie używa pamięci RAM tylko dla tej linii i natychmiast zbiera śmieci.

Kod działa z i od 2 do 100, ale dane, z którymi pracuję, mają ~ 23000 wierszy. A po około 21000 rzędach zabrakło mi pamięci RAM dla 32-bitowego programu Excel.

Korzystanie z 64-bitowego programu Excel nie jest opcją.

0
Barbarian772 31 marzec 2020, 16:20

3 odpowiedzi

Najlepsza odpowiedź

Jestem prawie w 100% pewien, że nie musisz kopiować całego wiersza programu Excel - w tym wszystkich możliwych kolumn, nawet pustych.

Spróbuj tego:

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
1
Scott Holtzman 31 marzec 2020, 13:46

Możesz użyć Autofilter(), aby wykonać jednorazowe kopiowanie i wklejanie:

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
0
HTH 31 marzec 2020, 14:02

Wypróbuj również ten kod, proszę. Powinno być bardzo szybkie:

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

Jeśli nie ma potrzeby kopiowania w „A1”, można go łatwo dostosować ...

0
FaneDuru 31 marzec 2020, 14:00