Удалить большое количество строк (например, ~ 500 тыс. Строк) на основе определенных критериев

Question

У меня большое количество строк и столбцов (например, 500 тыс. Строк и 20 столбцов), заполненных числами.

Я пытаюсь удалить все данные в столбце I, который имеет определенное значение (например, меньшечем или равно 8), но когда я пытаюсь использовать автофильтр для удаления значений, он замораживает Excel и не удаляет.

Он работает быстро для данных в столбце А. Я переделал аналогичные данные вновый лист, чтобы убедиться, что все ячейки заполнены, столбцы / строки не были скрыты и т. д.

Почему он замерзает для столбца I?

Sub DeleteRow()

    Application.DisplayAlerts = False
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False

    Dim ws As Worksheet
    Dim rng As Range
    Dim lastRow As Long

    Set ws = ActiveWorkbook.Sheets("Sheet1")

    'filter and delete all but header row which is in row 3
    lastRow = ws.Range("I" & ws.Rows.count).End(xlUp).row
    MsgBox lastRow
    Set rng = ws.Range("I3:I" & lastRow)

    ' filter and delete all but header row
    With rng
         .AutoFilter Field:=1, Criteria1:="<=8"
         .SpecialCells(xlCellTypeVisible).EntireRow.Delete
    End With

    ' turn off the filters
    If ActiveSheet.FilterMode Then
        ActiveSheet.ShowAllData
    End If

    Application.DisplayAlerts = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub

Answer 1

На SO много сообщений об удалении строк, некоторые хорошие, некоторые не очень хорошие.

Двумя наиболее распространенными из них являются автофильтр (который вы используете) и создание диапазона с помощью Union (с одним из которых Дэвид связал вас).

Для набора данных такого размера и такого количества удалений вы найдете любой метод, который использует ссылки на методы листа Excel (такие как автофильтр, поиск, сортировка, объединение, формулы и т. Д.)медленный. Некоторые из них будут лучше, чем другие, в зависимости от точной природы ваших данных.

Существует другой метод, который может работать для вас. То есть на самом деле не Удалить строк, а перезаписать данные измененной версией.

Обратите внимание, что это работает, только если у вас нет формул (ни на этом листе, нидругие), которые относятся к обрабатываемым данным.

Я запускал этот код на примере набора данных 500 тыс. строк, 20 столбцов случайных чисел 1..32 (т. е. около 25% или удаленных строк)

Это длилось ~ 10 с

Sub DeleteRows2()
    Dim ws As Worksheet
    Dim rng As Range
    Dim i As Long, j As Long
    Dim NewI As Long
    Dim dat, NewDat

    Dim TestCol As Long
    Dim Threashold As Long
    Dim LastRow  As Long, LastCol As Long
    Dim t1 As Single, t2 As Single

    t1 = Timer()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    TestCol = 9
    Threashold = 8

    Set ws = Sheet1
    With ws
        Set rng = .Range(.Cells(.Rows.Count, 1).End(xlUp), .Cells(1, .Columns.Count).End(xlToLeft))
    End With
    dat = rng.Value2
    ReDim NewDat(1 To UBound(dat, 1), 1 To UBound(dat, 2))

    LastRow = UBound(dat, 1)
    LastCol = UBound(dat, 2)

    NewI = 0
    For i = 1 To LastRow
        If dat(i, TestCol) > Threashold Then
            NewI = NewI + 1
            For j = 1 To LastCol
                NewDat(NewI, j) = dat(i, j)
            Next
        End If
    Next

    rng = NewDat

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

    t2 = Timer()
    MsgBox "deleted in " & t2 - t1 & "s"
End Sub

Answer 2

Прежде всего, с записями по 100кс, вам лучше переключиться на какое-то программное обеспечение для работы с базами данных

, придерживающееся Excel, если вы не возражаете переупорядочить записи, это довольно быстро:

Option Explicit

Sub DeleteRows()

    Application.DisplayAlerts = False
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False

    Dim rng As Range

    With ActiveWorkbook.Sheets("Sheet1")
        Set rng = .Range("I2", .Cells(.Rows.Count, "I").End(xlUp))
        With .Sort
            .SortFields.Clear
            .SortFields.Add Key:=rng(1), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

            .SetRange rng.CurrentRegion
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With

        With rng
            .AutoFilter Field:=1, Criteria1:="<=8"
            .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
        End With
        .AutoFilterMode = False
    End With


    Application.DisplayAlerts = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub

если вы не возражаете против порядка записей, его можно просто изменить, чтобы сохранить