Код VBA для удаления диапазона на основе переменной - работает медленно

Question

Я использую этот код для удаления диапазона, где определенная ячейка в последнем столбце (AA) этого диапазона равна переменной, указанной в другом месте на листе (К2).

Код использует Shift: xlUp для удаления этих данных и переноса остальной информации вверх.

Все это делается по одной строке за раз, пока условие больше не является истинным.

Единственная проблема заключается в том, что это выполняется довольно медленно - даже для 25-30 строк данных, удаляемых по одному за раз. Что я могу сделать, чтобы ускорить его?

Sub UncommitSession() 
Dim WHAT_TO_FIND As String 
Dim ws As Excel.Worksheet 
Dim FoundCell As Excel.Range 
Dim iVal As Integer 

iVal = Application.WorksheetFunction.CountIf(Range("AA5:AA800"), Range("K2")) 

WHAT_TO_FIND = Range("K2") 

For i = 1 To iVal 
    Set ws = ActiveSheet 
    Set FoundCell = ws.Range("AA:AA").Find(what:=WHAT_TO_FIND, lookat:=xlWhole) 
    If Not FoundCell Is Nothing Then 
    Range("Q" & FoundCell.Row & ":AA" & FoundCell.Row).Delete Shift:=xlUp 
    Else 
    MsgBox (WHAT_TO_FIND & " not found in session archive.") 
    End If 
Next i 
End Sub 

Answer 1

Я думаю, что самым быстрым решением является установка автофильтров, выбор видимых строк и их удаление. Вот пример одного из моих проектов, который использует автоматический фильтр через список объектов:

Dim lstTable As ListObject: Set lstTable = rngTarget.Worksheet.ListObjects.Add(xlSrcRange, rngTarget, , xlYes) 
lstTable.Range.AutoFilter colFilter, varValue 
lstTable.DataBodyRange.EntireRow.Delete 

В выше, вы должны изменить rngTarget обратиться к вашему столу, colFilter для обозначения быть номер столбца AA и varValue - WHAT_TO_FIND.

Update

Настройка его в код:

Sub UncommitSession() 
    Dim ewsTarget As Worksheet: Set ewsTarget = ActiveSheet 
    Dim varValue As String: varValue = ewsTarget.Range("K2").Value 
    Dim rngTarget As Range: Set rngTarget = ewsTarget.Range("A5:AA800") 
    Dim lstTable As ListObject: Set lstTable = rngTarget.Worksheet.ListObjects.Add(xlSrcRange, rngTarget, , xlYes) 
    lstTable.Range.AutoFilter ewsTarget.Range("AA1") - ewsTarget.Range("A1") + 1, varValue 
    lstTable.TableStyle = vbNullString 
    lstTable.DataBodyRange.EntireRow.Delete 
    lstTable.Unlist 
End Sub 

у меня нет, однако, ваш Workbook, поэтому я не могу проверить это.