如何在 VBA 中更快地删除 123572 行？答案

【问题标题】：How can I delete 123572 rows faster in VBA?如何在 VBA 中更快地删除 123572 行？
【发布时间】：2023-02-03 21:05:53
【问题描述】：

我有一个包含超过 1 张工作表的文件，在报告工作表中我想按 ASBN 产品过滤然后删除它们，因为我已经在另一张工作表中处理过它，所以我需要删除初始的以便粘贴回处理了一个

想法是这个正在运行的删除代码，但至少需要 20 分钟，因为我想删除 123 572 行，你知道我怎样才能使这项工作更快吗？

我也尝试先清除内容然后删除空行，但它是一样的..

先感谢您。

在这里你可以找到代码：




Public Sub Remove_ABSN()

Dim area As String
Dim start As Long

area = "ABSN"

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


start = Worksheets("Reports").Cells(Cells.Rows.Count, 1).End(xlUp).Row
Worksheets("Reports").Range("$A$2:$AN" & start).AutoFilter Field:=8, Criteria1:=area, Operator:=xlFilterValues

Worksheets("Reports").Range("$A$2:$AN$" & start).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Sheets("Reports").ShowAllData


Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = True
Application.EnableEvents = True

End Sub

【问题讨论】：

查看these posts中的一个，看看是否有可以使用的东西。
如果您不介意创建一个帮助表，那么也许您想做这样的事情：With Range("$A$2:$AN" & start): .AutoFilter Field:=8, Criteria1:=area, Operator:=xlFilterValues: .AutoFilter Field:=40, Criteria1:="<>": .SpecialCells(xlVisible).Copy: End With --> 这将复制第 8 列包含“ABSN”且第 40 列不为空的指定范围。然后Sheets.Add before:=ActiveSheet: Range("A2").PasteSpecial (xlAll)这将创建一个新工作表并将复制的单元格粘贴到新工作表上的单元格 A2 中。编写删除旧工作表并重命名新工作表的代码即可完成。

标签： excel vba delete-row

【解决方案1】：

我认为 AutoFilter 将是最快的方法。这里有两个示例脚本可供尝试。你可以自己看看哪个更快。

Public Sub UnionDeleteRowsFast()

' Careful...delete runs on Sheet1

   Dim sh2 As Worksheet
   Set sh2 = Sheets("Sheet1")
   Dim lastrow As Long
   Dim Rng As Range

   lastrow = Cells(Rows.Count, "B").End(xlUp).Row
   
   For i = lastrow To 2 Step -1
      If Cells(i, 2).Value = "Delete" Then
         If Rng Is Nothing Then
            Set Rng = Range("B" & i)
         Else
            Set Rng = Union(Rng, Range("B" & i))
         End If
      End If
   Next
   If Not Rng Is Nothing Then Rng.EntireRow.Delete
End Sub


Sub AutoFilterDeleteRowsFast()

' Careful...delete runs on ActiveSheet

With ActiveSheet
    .AutoFilterMode = False
    With Range("B4", Range("B" & Rows.Count).End(xlUp))
        .AutoFilter 1, "*Delete*"
        On Error Resume Next
        .Offset(1).SpecialCells(12).EntireRow.Delete
    End With
    .AutoFilterMode = False
End With
End Sub

【讨论】：