Excel VBA性能 - 100万行 - 在不到1分钟的时间内删除包含值的行

Question

Excel VBA性能 - 100万行 - 在不到1分钟的时间内删除包含值的行

我试图在不到一分钟的时间内找到一种方法来过滤大数据并删除工作表中的行

目标：

• 在第1列中查找包含特定文本的所有记录，然后删除整行

• 保持所有单元格格式（颜色，字体，边框，列宽）和公式

。

测试数据：

：

。

代码如何工作：

1. 首先关闭所有Excel功能

2. 如果工作簿不为空，并且要删除的文本值存在于第1列中

• 将单元格地址添加到格式的tmp字符串中 "A11,A275,A3900,..."

• 如果tmp变量长度接近255个字符

• 使用删除行 .Range("A11,A275,A3900,...").EntireRow.Delete Shift:=xlUp

• 将tmp重置为空并继续前进到下一组行

• 将列1的已使用范围复制到数组

• 向后迭代数组中的每个值

• 当找到匹配时：

3. 最后，它将所有Excel功能重新打开

。

主要问题是删除操作，总持续时间应低于一分钟。任何基于代码的解决方案都是可以接受的，只要它在1分钟内执行即可。

这将范围缩小到极少数可接受的答案。已经提供的答案也非常简短，易于实施。一个人在大约30秒内执行操作，因此至少有一个答案提供了可接受的解决方案，其他人可能会发现它也很有用

。

我的主要初始功能：

Sub DeleteRowsWithValuesStrings()
    Const MAX_SZ As Byte = 240

    Dim i As Long, j As Long, t As Double, ws As Worksheet    Dim memArr As Variant, max As Long, tmp As String

    Set ws = Worksheets(1)
    max = GetMaxCell(ws.UsedRange).Row
    FastWB True:    t = Timer    With ws        If max > 1 Then
            If IndexOfValInRowOrCol("Test String", , ws.UsedRange) > 0 Then
                memArr = .Range(.Cells(1, 1), .Cells(max, 1)).Value2                For i = max To 1 Step -1

                    If memArr(i, 1) = "Test String" Then
                        tmp = tmp & "A" & i & ","
                        If Len(tmp) > MAX_SZ Then
                           .Range(Left(tmp, Len(tmp) - 1)).EntireRow.Delete Shift:=xlUp
                           tmp = vbNullString                        End If
                    End If

                Next
                If Len(tmp) > 0 Then
                    .Range(Left(tmp, Len(tmp) - 1)).EntireRow.Delete Shift:=xlUp                End If
                .Calculate            End If
        End If
    End With
    FastWB False:   InputBox "Duration: ", "Duration", Timer - tEnd Sub

Answer 1

如果源数据不包含公式，或者方案允许（或希望）在条件行删除期间将公式转换为硬值，则可以实现速度的显着提高。以上作为警告，我的解决方案使用范围对象的AdvancedFilter。它的速度大约是DeleteRowsWithValuesNewSheet（）的两倍。Public&nbsp;Sub&nbsp;ExcelHero() &nbsp;&nbsp;&nbsp;&nbsp;Dim&nbsp;t#,&nbsp;crit&nbsp;As&nbsp;Range,&nbsp;data&nbsp;As&nbsp;Range,&nbsp;ws&nbsp;As&nbsp;Worksheet&nbsp;&nbsp;&nbsp;&nbsp;Dim&nbsp;r&,&nbsp;fc&nbsp;As&nbsp;Range,&nbsp;lc&nbsp;As&nbsp;Range,&nbsp;fr1&nbsp;As&nbsp;Range,&nbsp;fr2&nbsp;As&nbsp;Range &nbsp;&nbsp;&nbsp;&nbsp;FastWB&nbsp;True &nbsp;&nbsp;&nbsp;&nbsp;t&nbsp;=&nbsp;Timer&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Set&nbsp;fc&nbsp;=&nbsp;ActiveSheet.UsedRange.Item(1) &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Set&nbsp;lc&nbsp;=&nbsp;GetMaxCell&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Set&nbsp;data&nbsp;=&nbsp;ActiveSheet.Range(fc,&nbsp;lc) &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Set&nbsp;ws&nbsp;=&nbsp;Sheets.Add&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;With&nbsp;data&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Set&nbsp;fr1&nbsp;=&nbsp;data.Worksheet.Range(fc,&nbsp;fc.Offset(,&nbsp;lc.Column)) &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Set&nbsp;fr2&nbsp;=&nbsp;ws.Range(ws.Cells(fc.Row,&nbsp;fc.Column),&nbsp;ws.Cells(fc.Row,&nbsp;lc.Column)) &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;With&nbsp;fr2 &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;fr1.Copy&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;.PasteSpecial&nbsp;xlPasteColumnWidths:&nbsp;.PasteSpecial&nbsp;xlPasteAll&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;.Item(1).Select &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;End&nbsp;With &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Set&nbsp;crit&nbsp;=&nbsp;.Resize(2,&nbsp;1).Offset(,&nbsp;lc.Column&nbsp;+&nbsp;1) &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;crit&nbsp;=&nbsp;[{"Column&nbsp;1";"<>Test&nbsp;String"}] &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;.AdvancedFilter&nbsp;xlFilterCopy,&nbsp;crit,&nbsp;fr2&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;.Worksheet.Delete&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;End&nbsp;With &nbsp;&nbsp;&nbsp;&nbsp;FastWB&nbsp;False &nbsp;&nbsp;&nbsp;&nbsp;r&nbsp;=&nbsp;ws.UsedRange.Rows.Count &nbsp;&nbsp;&nbsp;&nbsp;Debug.Print&nbsp;"Rows:&nbsp;"&nbsp;&&nbsp;r&nbsp;&&nbsp;",&nbsp;Duration:&nbsp;"&nbsp;&&nbsp;Timer&nbsp;-&nbsp;t&nbsp;&&nbsp;"&nbsp;seconds"End&nbsp;Sub

Answer 2

在我的老人戴尔Inspiron 1564（Win 7 Office 2007）上：Sub&nbsp;QuickAndEasy() &nbsp;&nbsp;&nbsp;&nbsp;Dim&nbsp;rng&nbsp;As&nbsp;Range&nbsp;&nbsp;&nbsp;&nbsp;Set&nbsp;rng&nbsp;=&nbsp;Range("AA2:AA1000001") &nbsp;&nbsp;&nbsp;&nbsp;Range("AB1")&nbsp;=&nbsp;Now &nbsp;&nbsp;&nbsp;&nbsp;Application.ScreenUpdating&nbsp;=&nbsp;False &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;With&nbsp;rng&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;.Formula&nbsp;=&nbsp;"=If(A2=""Test&nbsp;String"",0/0,A2)" &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;.Cells.SpecialCells(xlCellTypeFormulas,&nbsp;xlErrors).EntireRow.Delete&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;.Clear&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;End&nbsp;With &nbsp;&nbsp;&nbsp;&nbsp;Application.ScreenUpdating&nbsp;=&nbsp;True &nbsp;&nbsp;&nbsp;&nbsp;Range("AC1")&nbsp;=&nbsp;NowEnd&nbsp;Sub跑了大概10秒钟。我假设AA列可用。编辑＃1：请注意，此代码未将“&nbsp;计算&nbsp;”&nbsp;设置为“手动”。如果在允许“帮助”列计算后将计算模式设置为手动，则性能将得到改善。