Question

在我的电子表格中，我有近2,000行。我需要搜索这些行，找到一个特定的日期（当前日期），然后删除相应的范围。然而它运行非常缓慢。有关如何让它运行得更快的任何建议？我想也许我可以根据日期组织我的行（当前日期将始终是最旧的，因此在顶部）然后使用范围（XX：XX“）一次删除所有行。删除。但我不知道如何找到最后一行与Currentdate的位置，因为它会不断变化。

Sub ChangeandDelete
 MudaDataLCA
 DeleteDateLCA
End Sub

Sub MudaDataLCA()
'===Muda Data Atual ABERTURA===
Dim Affected As Workbook
Dim Dados As Worksheet
Dim LastRow As Long


Set Affected = Workbooks("Controle de Lastro LCA_FEC - Test")
Set Dados = Affected.Sheets("DADOS")
Dados.Activate
    Dim CurrentDate As Date
    CurrentDate = Range("AH2") + 1
    Range("AH2") = CurrentDate


End Sub
Sub DeleteDateLCA()
Dim Affected As Workbook
Dim Dados As Worksheet
Dim LastRow As Long

Set Affected = Workbooks("Controle de Lastro LCA_FEC - Test")
Set Dados = Affected.Sheets("DADOS")
Dados.Activate

LastRow = Dados.Cells(Rows.Count, "P").End(xlUp).Row
    For i = 5 To LastRow
        Do While Range("S" & i).Value = Range("AH2")
        Range("P" & i & ":AG" & i).Delete
        Loop
    Next i

End Sub

Answer 1

这种在AH2中过滤更新日期的方法应该可以显着加快这一过程。

Sub ChangeandDelete()
    Dim fr As Long, lr As Long, fString As String
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    With Workbooks("Controle de Lastro LCA_FEC - Test").Sheets("DADOS")
        .Range("AH2") = CDate(.Range("AH2").Value + 1)
        fr = 4: lr = .Cells(Rows.Count, "P").End(xlUp).Row
        fString = Chr(61) & Format(.Range("AH2").Value, .Range("P5").NumberFormat)
        With .Range(.Cells(fr, "P"), .Cells(lr, "P"))
            .AutoFilter
            .AutoFilter Field:=1, Criteria1:=fString
            If CBool(Application.Subtotal(102, .Columns(1)) + IsNumeric(.Cells(1, 1).Value2)) Then
                With .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count)
                    .SpecialCells(xlCellTypeVisible).EntireRow.Delete
                End With
                Debug.Print Application.Count(.Columns(1))
            End If
            .AutoFilter
        End With
    End With
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub

我假设每次删除行时，至少部分减速是公式重新计算，这表示自动计算。我已经关闭了自动计算并在过程完成后将其恢复。还有其他方法可以存储工作簿/工作表计算的当前状态，关闭计算，然后恢复原始状态。

Answer 2

所以我有两个答案。我输入了39000行数据并使用符合删除标准的7500行进行了 - 所以我可以测试时间（64位Windows 7）

循环可能超级慢，但我会先写这个，因为它最接近你的代码：

Sub DeleteIT()

Dim deleteRange As Range
Dim deleteValue As Date
Dim lastRow As Long

Set affected = ThisWorkbook
Set dados = affected.Sheets("DADOS")

Dim CTtimer As CTimer
'Set CTtimer = New CTimer
'Dados.Activate
    Application.ScreenUpdating = False

deleteValue = dados.Range("AH2")
lastRow = dados.Range("S" & dados.Rows.Count).End(xlUp).Row
 'CTtimer.StartCounter
    Do
        Set deleteRange = Range("S5:S" & lastRow).Find(what:=deleteValue, LookIn:=xlValues, _
            lookat:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False)

        If Not deleteRange Is Nothing Then deleteRange.Range(Cells(1, 1), Cells(1, 18)).Offset(0, -3).Delete
    Loop While Not deleteRange Is Nothing
'MsgBox CTtimer.TimeElapsed

Application.ScreenUpdating = True

End Sub

我使用上面的代码在4分钟内完成了大约500行和150个匹配记录的删除。我做了一个代码中断并停止了因为没有人应该处理那个哈哈..

我的另一个想法（下面）更符合您的排序想法，这种方式只需要大约25秒就可以从31500行中删除30500次。

Sub aReader()
Dim affected As Workbook
Dim SheetName As String
Dim deleteValue As Date
Dim population As Range
Dim lastRow As Long
Dim x As Long
'Dim CTtimer As CTimer
'Set CTtimer = New CTimer
Set affected = ThisWorkbook

Application.ScreenUpdating = False

SheetName = "DADOS"

deleteValue = affected.Worksheets(SheetName).Range("AH2")

Set population = Worksheets(SheetName).Range("P5", Sheets(SheetName).Range("P5").End(xlDown))
'CTtimer.StartCounter

For x = 1 To population.Count

    If population.Cells(x, 4).Value = deleteValue Then Range(population.Cells(x, 1), population.Cells(x, 18)).Value = ""

Next x

Range("P5:AG" & (population.Count + 4)).Sort key1:=Range("S5:S" & population.Count + 4), _
   order1:=xlAscending, Header:=xlNo

Application.ScreenUpdating = True
'MsgBox CTtimer.TimeElapsed
End Sub

查找特定值，删除相应的范围。宏令人痛苦地缓慢

2 个答案: