Vba 删除包含特定值的所有行（最有效的方法？）

大家好，我正在尝试编写一个宏来处理一个巨大的文件（30-35k行）。我有一个循环，它遍历列

a

中的所有单元格，并删除列

a

中日期不等于昨天日期的所有行。（听起来很复杂，我知道）。有没有更有效的方法？我的意思是循环工作，但它经常崩溃excel和超时等

Sub PSAudit()
Dim Auditdate As String
Dim rng As Range
Dim psm as worksheet

Set psm = Sheets("PS_MAIN")
Application.ScreenUpdating = False

        Auditdate = Format(Date - 1, "yyyy-mm-dd")

    lastrow = Cells(Rows.Count, "A").End(xlUp).Row
    For x = 1 To lastrow

        If psm.Range("A" & x).Value <> Auditdate Then psm.Range("A" & x).EntireRow.Delete

    Next x


Application.ScreenUpdating = True


End Sub

Sub-PSAudit（）
将审核日期设置为字符串
变暗rng As范围
将psm设置为工作表
设置psm=图纸（“PS_主图纸”）
Application.ScreenUpdating=False
审核日期=格式（日期-1，“yyyy-mm-dd”）
lastrow=单元格（Rows.Count，“A”）.End（xlUp）.Row
对于x=1到最后一行
如果psm.Range（“A”&x）.值为Auditdate，则psm.Range（“A”&x）.EntireRow.Delete
下一个x
Application.ScreenUpdating=True
端接头

我将执行以下操作：

Sub PSAudit()
    Dim psm As Worksheet
    Set psm = ThisWorkbook.Sheets("PS_MAIN")
    Dim LastRow As Long
    Dim Auditdate As String
    Auditdate = Format(Now() - 1, "yyyy-mm-dd")
    Application.Calculation = xlCalculationManual
    LastRow = Cells(Rows.Count, "A").End(xlUp).Row
    For x = LastRow To 1 Step -1
        If psm.Cells(x, 1).Value <> Auditdate Then
            psm.Cells(x, 1).EntireRow.Delete
        End If
        DoEvents
    Next x
    Application.Calculation = xlCalculationAutomatic
End Sub

Sub-PSAudit（）
将psm设置为工作表
设置psm=ThisWorkbook.Sheets（“PS_MAIN”）
最后一排一样长
将审核日期设置为字符串
Auditdate=格式（现在（）-1，“yyyy-mm-dd”）
Application.Calculation=xlCalculationManual
LastRow=单元格（Rows.Count，“A”）.End（xlUp）.Row
对于x=LastRow至1步骤-1
如果psm.单元格（x，1）.值为Auditdate，则
psm.Cells（x，1）.EntireRow.Delete
如果结束
多芬特
下一个x
Application.Calculation=xlCalculationAutomatic
端接头

说明： 首先，当您使用

for next

删除行（或列）时，从底部开始。 其次，如果在过程上放置

DoEvents

，则文件不会崩溃。

---

第三，使用完整的单元格地址，您可以在脚本运行时自由地处理文件（甚至在其他工作表上），甚至处理其他工作簿。

您需要从底部开始，因为一旦删除一行，您的索引将被删除一行。您还应该为

LastRow

查询确认工作表。也不知道为什么要声明

rng

，因为您不使用它。最后，如果工作簿包含任何公式，我将关闭计算

Sub PSAudit()

    Dim Auditdate As String
    Dim psm As Worksheet

    Set psm = Sheets("PS_MAIN")
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    Auditdate = Format(Date - 1, "yyyy-mm-dd")

    lastrow = psm.Cells(Rows.Count, "A").End(xlUp).Row

      For x = lastrow To 1 Step -1
          With psm.Range("A" & x)
              If .Value <> Auditdate Then .EntireRow.Delete
          End With
      Next x

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

End Sub

Sub-PSAudit（）
将审核日期设置为字符串
将psm设置为工作表
设置psm=图纸（“PS_主图纸”）
Application.ScreenUpdating=False
Application.Calculation=xlCalculationManual
审核日期=格式（日期-1，“yyyy-mm-dd”）
lastrow=psm.Cells（Rows.Count，“A”）.End（xlUp）.Row
对于x=lastrow至1步骤-1
带psm.Range（“A”和x）
如果.Value Auditdate，则.EntireRow.Delete
以
下一个x
Application.ScreenUpdating=True
Application.Calculation=xlCalculationAutomatic
端接头

逐行删除将非常缓慢，因此您应该按日期排序，并立即删除所有行。这是最快的方法。

使用

.Find（）

总是比在所有行中循环要快得多（除了少量的行）

这是未经测试，但应该让你开始。您可能需要稍微调整一下

What:=”

参数，然后再使用它。当你在搜索某个特定的东西时，要比搜索不特定的东西容易得多。我建议您使用对话框优化搜索，以准确确定需要在

what:=''

参数中输入的内容

请记住，

.Find（）

将使用UI对话框中定义的所有搜索设置，除非您在代码中指定它们，并且在代码中更改它们也将更改您在对话框中看到的内容

Private Sub PSAudit()

  On Error GoTo cleanExit
  Dim auditDate As Date
  auditDate = Date

  Dim previousCalculation As Long
  previousCalculation = Application.Calculation
  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual

  Dim psm As Worksheet
  Set psm = ActiveWorkbook.Worksheets("PS_MAIN")
  Dim searchRange As Range
  Set searchRange = psm.Columns("A")

  Dim oldDates As Range
  Set oldDates = psm.Columns.Find(What:="< auditDate", LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns)

  If not oldDates is Nothing then
    Dim deleteRow As Range
    For Each deleteRow In oldDates
      deleteRow.EntireRow.Delete
    Next
 End If

cleanExit:
  Application.ScreenUpdating = True
  Application.Calculation = previousCalculation

End Sub

Private Sub-PSAudit（）
返回cleanExit时出错
将审核日期设置为日期
审核日期=日期
如长
previousCalculation=Application.Calculation
Application.ScreenUpdating=False
Application.Calculation=xlCalculationManual
将psm设置为工作表
设置psm=ActiveWorkbook.Worksheets（“PS_MAIN”）
将搜索范围变暗为范围
设置searchRange=psm.Columns（“A”）
暗淡的旧日期范围
设置oldDates=psm.Columns.Find（内容：=“

---

如其他人所述，关闭

.ScreenUpdate

和

Calculation

，将在一定程度上缩短处理时间，但

.Find（）

将是最大的挑战。

扩展@ingwarus answer，根据地址一次删除所有行会更快

Sub PSAudit()
    Dim Auditdate As String
    Dim rng As Range
    Dim psm As Worksheet
    Dim vArr(), i As Long
    Dim auStart As Long, auEnd As Long

    DisFun False

    Set psm = ThisWorkbook.Worksheets("PS_MAIN")
    Auditdate = Format(Date - 1, "yyyy-mm-dd")
    Set rng = psm.Range("A1:D" & Range("A" & psm.Rows.Count).End(xlUp).Row)
    'Set rng = psm.Range("A1").CurrentRegion
    rng.Sort rng.Cells(1, 1), xlAscending, , , , , , xlNo
    vArr = Application.Transpose(rng.Columns("A").Value)
    For i = LBound(vArr) To UBound(vArr)
        If vArr(i) = Auditdate Then auStart = i: Exit For
    Next i
    For i = UBound(vArr) To LBound(vArr) Step -1
        If vArr(i) = Auditdate Then auEnd = i: Exit For
    Next i
    Select Case True
        'Auditdate is at start
        Case auStart = 1
            psm.Range(auEnd + 1 & ":" & UBound(vArr)).EntireRow.Delete
        'Auditdate is at the end
        Case auEnd = UBound(vArr)
            psm.Range("1:" & auStart - 1).EntireRow.Delete
        'Auditdate in between
        Case Else
            psm.Range("1:" & auStart - 1 & "," & auEnd + 1 & ":" & UBound(vArr)).EntireRow.Delete
    End Select

    DisFun True

End Sub

首先，我们需要定义范围并对其进行排序。
其次，我们需要找到审核日期的第一次和最后一次出现时间
根据auStart和auEnd值，我们可以缩小某些情况并相应地删除行。
我使用了help sub one，可以在以后的项目中找到有用的帮助：

Private Sub DisFun(ByVal Status As Boolean)
    With Application
        .ScreenUpdating = Status
        .EnableEvents = Status
        .DisplayStatusBar = Status
        .Calculation = IIf(Status, -4105, -4135)
    End With
End Sub

---

删除行时，从底部开始，然后逐步向上：

对于x=lastrow到第1步-1

它会加快代码速度吗？@Rhyfelwr它至少会正确删除所有行。这是一个开始！。。。循环工作，但它经常崩溃excel并超时。。。如果它崩溃，请在删除后尝试使用

DoEvents

。在你的IF之后输入并测试它。另外，使用

Application.Calculation=xlCalculationManual

禁用计算将有助于反向循环行，从而避免删除不应删除的行未指定

单元格的parent object

，以及

行的parent object
Application.ScreenUpdate=False/True
比
Application.Calculation
更适用于此过程，除非OP在工作表中有大量公式。嗯，很抱歉，此代码甚至比我的原始代码慢，尽管它确实有效！但当宏运行时，文件保持可编辑状态。。。R