根据特定条件删除大量行(例如，约50万行) [英] Delete large number of rows (e.g. ~500k rows) based on a certain criteria

问题描述

我有大量的行和列(例如50万行和20列)，都充满了数字.

I have a large number of rows and columns (e.g. 500k rows and 20 columns) all filled with numbers.

我正在尝试删除I列中具有某个特定值(例如，小于或等于8)的所有数据，但是当我尝试使用自动过滤器删除这些值时，它将冻结Excel且不会删除

I'm trying to delete all data in column I that has a certain value (e.g. less than or equal to 8), but when I try to use autofilter to delete the values, it freezes up Excel and doesn't delete.

它对于A列中的数据很快起作用.我在新的工作表中重新制作了类似的数据，以确保所有单元格都已填充，没有任何列/行被隐藏等.

It works quickly for data in column A. I remade similar data in a new sheet to make sure all cells were filled, no columns/rows were hidden etc.

为什么第一列冻结?

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

推荐答案

SO上有很多关于删除行的文章，有些不错，有些不好.

There are a lot of posts on SO about deleting rows, some good, some not so good.

两个常见的是自动过滤器(您正在使用)和通过联合建立范围(大卫已将您链接到其中之一).

Two common ones are the Autofilter (which you are using) and building a range with Union (one of which David has linked you to).

对于这种大小和许多删除的数据集，您会发现任何方法使用对Excel工作表方法(例如自动筛选，查找，排序，并集，公式的等)的引用都很慢.根据您的数据的确切性质，某些数据会比其他数据更好.

For a data set of this size and this many deletions, you will find any method that uses references to Excel worksheet methods (such as AutoFilter, Find, Sort, Union, Formula's etc) slow. Some will be better than others, depending on the exact nature of your data.

还有另一种可能适合您的方法.那实际上不是删除行，而是用修改后的版本覆盖数据.

There is another method that may work for you. That is to not actually Delete the rows, but to overwrite the data with a modified version.

请注意，只有当您没有任何公式(在此表或其他表格上)引用正在处理的数据时，此方法才起作用.

Note that this only work if you DO NOT have any formulas (either on this sheet or any other) that refer to the data being processed.

我在500k行，20列随机数1..32的示例数据集上运行了此代码(因此大约25％或删除了行)

I ran this code on a sample data set 500k rows, 20 columns of random numbers 1..32 (so about 25% or rows deleted)

这只需要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

这篇关于根据特定条件删除大量行(例如，约50万行)的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！