Удалить строки к югу очень медленно для обработки

Question

Я построил макрос в Excel, который сохраняет данные из нескольких вкладок в базе данных (формат таблицы).В качестве части макроса я включил подпрограмму для удаления любых предыдущих записей за определенный год (CYear) перед написанием новых записей для этого года.

Это работало нормально, пока размер рабочей книги не увеличился примерно до 10 МБ.Следующая часть кода теперь выполняется> 1 часа.Есть ли другой метод, который может быть быстрее?

Application.ScreenUpdating = False и Application.Calculation = xlCalculationManual включены как часть большего Sub, r подойдет к нескольким тысячам строк.

Dim r As Long
Sheets("Database").Activate

For r = ActiveSheet.UsedRange.Rows.Count To 1 Step -1

    If Cells(r, "G") = Range("C5") Then
        ActiveSheet.Rows(r).EntireRow.Delete
    End If
Next

Answer 1

Эй, боб Я обнаружил, что когда ты работаешь с тысячами строк или сотнями тысяч, ты можешь попробовать массивы.Они безумно быстро делают то же самое, что и на листе

Попробуйте:

Sub DeleteRows()

    Dim arr, arr1, yeartocheck As Integer, yearchecked As Integer, ws As Worksheet, i As Long, j As Long, x As Long

    Set ws = ThisWorkbook.Sheets("DataBase")
    yeartocheck = ws.Range("C5")

    arr = ws.UsedRange.Value 'the whole sheet allocated on memory

    ReDim arr1(1 To UBound(arr), 1 To UBound(arr, 2)) 'lets define another array as big as the first one

    For i = 1 To UBound(arr1, 2) 'headers for the final array
        arr1(1, i) = arr(1, i)
    Next i

    x = 2 'here starts the data on the final array (1 is for the headers)

    For i = 2 To UBound(arr) 'loop the first array looking to match your condition
        yearchecked = arr(i, 7)
        If yearchecked <> yeartocheck Then 'if they don't match, the macro will store that row on the final array
            For j = 1 To UBound(arr, 2)
                arr1(x, j) = arr(i, j)
            Next j
            x = x + 1 'if we store a new row, we need to up the x
        End If
    Next i

    With ws
        .UsedRange.ClearContents 'clear what you have
        .Range("A1", .Cells(UBound(arr1), UBound(arr, 2))).Value = arr1 'fill the sheet with all the data without the CYear
    End With


End Sub

Answer 2

Удаление чего-либо на рабочем листе - это довольно медленная операция, и в зависимости от того, сколько строк вы хотите удалить (и, кажется, это много), вы должны собрать все, что должно быть удалено, в Range -вариант иудалите все сразу.

Еще один аспект заключается в том, что UsedRange не всегда надежен, и, если вам не повезет, макрос проверяет все из самой последней возможной строки (= 1048576), что также может бытьпроблема.Конструкция .Cells(.Rows.Count, "G").End(xlUp).row получит номер строки последней использованной строки в столбце «G».

Попробуйте следующий код

Sub del()

    Dim r As Long
    Dim deleteRange As Range
    Set deleteRange = Nothing

    With ThisWorkbook.Sheets(1)
        For r = .Cells(.Rows.Count, "G").End(xlUp).row To 1 Step -1
            If .Cells(r, "G") = .Range("C5") Then
                If deleteRange Is Nothing Then
                    Set deleteRange = .Cells(r, "G")
                Else
                    Set deleteRange = Union(deleteRange, .Cells(r, "G"))
                End If
            End If
        Next
    End With

    If Not deleteRange Is Nothing Then
        deleteRange.EntireRow.Delete
    End If
End Sub