Question

您好，我正在尝试编写一个宏来处理一个巨大的文件（说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

Answer 1

我会做以下事情：

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

说明：首先，当您使用for next删除行（或列）时，从底部开始。其次，如果在程序上放置DoEvents，则文件不会崩溃。第三，使用完整单元格地址可让您自由地处理文件（甚至在其他工作表上），甚至可以在脚本运行时处理其他工作簿。

Answer 2

您需要从底部开始，因为删除一行后，您的索引会超出一行。您还应该为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

Answer 3

扩展@ingwarus答案，根据地址删除所有行的速度会更快。

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

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

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

Answer 4

使用.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

如其他人所述，关闭.ScreenUpdating和.Calculation会稍微改善处理时间，但.Find()将成为最佳击球手。

Answer 5

逐行删除会非常慢，因此您应该按日期排序并一次删除所有行。这是最快的方式。

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

5 个答案: