Question

我有很多行和列（例如50万行和20列），都充满了数字。

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

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

为什么第一列冻结？

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建立范围（David已将您链接到其中之一）。

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

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

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

我在500k行，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

首先，拥有100ks条记录，您最好切换到一些面向数据库的软件

坚持使用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

如果您介意记录顺序，可以简单地使其保持不变

根据特定条件删除大量行（例如，约50万行）

2 个答案: