Я пытаюсь найти способ фильтрации больших данных и удаления строк на листе, менее чем за минуту
Цель:
- Найти все записи, содержащие конкретный текст в столбце 1, и удалить всю строку
- Сохраняйте все форматирование ячейки (цвета, шрифт, границы, ширину столбцов) и формулы, как они
.
Данные теста:
:
.
Как работает код:
- Он начинается с включения всех функций Excel.
-
Если рабочая книга не пуста и текстовое значение, которое нужно удалить, существует в столбце 1
- Копирует используемый диапазон столбца 1 в массив
- Итерации по каждому значению в массиве назад
-
Когда он найдет совпадение:
- Добавляет адрес ячейки в строку tmp в формате
"A11,A275,A3900,..." - Если длина переменной tmp близка к 255 символам
- Удаляет строки с помощью
.Range("A11,A275,A3900,...").EntireRow.Delete Shift:=xlUp - Сбрасывает tmp на пустой и переходит к следующему набору строк
- Добавляет адрес ячейки в строку tmp в формате
- В конце все функции Excel снова включены.
.
Основная проблема - операция удаления, а общая продолжительность - не более одной минуты. Любое решение на основе кода приемлемо, если оно выполняется менее 1 минуты.
Это сужает область применения до очень немногих приемлемых ответов. Полученные ответы также очень короткие и легкие в реализации. Один из выполняет операцию примерно через 30 секунд, поэтому существует хотя бы один ответ, который обеспечивает приемлемое решение, а другие могут также оказаться полезными
.
Моя основная начальная функция:
Sub DeleteRowsWithValuesStrings()
Const MAX_SZ As Byte = 240
Dim i As Long, j As Long, t As Double, ws As Worksheet
Dim memArr As Variant, max As Long, tmp As String
Set ws = Worksheets(1)
max = GetMaxCell(ws.UsedRange).Row
FastWB True: t = Timer
With ws
If max > 1 Then
If IndexOfValInRowOrCol("Test String", , ws.UsedRange) > 0 Then
memArr = .Range(.Cells(1, 1), .Cells(max, 1)).Value2
For i = max To 1 Step -1
If memArr(i, 1) = "Test String" Then
tmp = tmp & "A" & i & ","
If Len(tmp) > MAX_SZ Then
.Range(Left(tmp, Len(tmp) - 1)).EntireRow.Delete Shift:=xlUp
tmp = vbNullString
End If
End If
Next
If Len(tmp) > 0 Then
.Range(Left(tmp, Len(tmp) - 1)).EntireRow.Delete Shift:=xlUp
End If
.Calculate
End If
End If
End With
FastWB False: InputBox "Duration: ", "Duration", Timer - t
End Sub
Вспомогательные функции (выключите и включите функции Excel):
Public Sub FastWB(Optional ByVal opt As Boolean = True)
With Application
.Calculation = IIf(opt, xlCalculationManual, xlCalculationAutomatic)
.DisplayAlerts = Not opt
.DisplayStatusBar = Not opt
.EnableAnimations = Not opt
.EnableEvents = Not opt
.ScreenUpdating = Not opt
End With
FastWS , opt
End Sub
Public Sub FastWS(Optional ByVal ws As Worksheet = Nothing, _
Optional ByVal opt As Boolean = True)
If ws Is Nothing Then
For Each ws In Application.ActiveWorkbook.Sheets
EnableWS ws, opt
Next
Else
EnableWS ws, opt
End If
End Sub
Private Sub EnableWS(ByVal ws As Worksheet, ByVal opt As Boolean)
With ws
.DisplayPageBreaks = False
.EnableCalculation = Not opt
.EnableFormatConditionsCalculation = Not opt
.EnablePivotTable = Not opt
End With
End Sub
Находит последнюю ячейку с данными (спасибо @ZygD - теперь я тестировал ее в нескольких сценариях):
Public Function GetMaxCell(Optional ByRef rng As Range = Nothing) As Range
'Returns the last cell containing a value, or A1 if Worksheet is empty
Const NONEMPTY As String = "*"
Dim lRow As Range, lCol As Range
If rng Is Nothing Then Set rng = Application.ActiveWorkbook.ActiveSheet.UsedRange
If WorksheetFunction.CountA(rng) = 0 Then
Set GetMaxCell = rng.Parent.Cells(1, 1)
Else
With rng
Set lRow = .Cells.Find(What:=NONEMPTY, LookIn:=xlFormulas, _
After:=.Cells(1, 1), _
SearchDirection:=xlPrevious, _
SearchOrder:=xlByRows)
If Not lRow Is Nothing Then
Set lCol = .Cells.Find(What:=NONEMPTY, LookIn:=xlFormulas, _
After:=.Cells(1, 1), _
SearchDirection:=xlPrevious, _
SearchOrder:=xlByColumns)
Set GetMaxCell = .Parent.Cells(lRow.Row, lCol.Column)
End If
End With
End If
End Function
Возвращает индекс соответствия в массиве или 0, если совпадение не найдено:
Public Function IndexOfValInRowOrCol( _
ByVal searchVal As String, _
Optional ByRef ws As Worksheet = Nothing, _
Optional ByRef rng As Range = Nothing, _
Optional ByRef vertical As Boolean = True, _
Optional ByRef rowOrColNum As Long = 1 _
) As Long
'Returns position in Row or Column, or 0 if no matches found
Dim usedRng As Range, result As Variant, searchRow As Long, searchCol As Long
result = CVErr(9999) '- generate custom error
Set usedRng = GetUsedRng(ws, rng)
If Not usedRng Is Nothing Then
If rowOrColNum < 1 Then rowOrColNum = 1
With Application
If vertical Then
result = .Match(searchVal, rng.Columns(rowOrColNum), 0)
Else
result = .Match(searchVal, rng.Rows(rowOrColNum), 0)
End If
End With
End If
If IsError(result) Then IndexOfValInRowOrCol = 0 Else IndexOfValInRowOrCol = result
End Function
.
Update:
Протестировано 6 решений (по 3 теста каждый): Решение Excel Hero является самым быстрым (удаляет формулы)
.
Вот результаты, самые быстрые до самых медленных:
.
Тест 1. Всего 100 000 записей, 10 000 для удаления:
1. ExcelHero() - 1.5 seconds
2. DeleteRowsWithValuesNewSheet() - 2.4 seconds
3. DeleteRowsWithValuesStrings() - 2.45 minutes
4. DeleteRowsWithValuesArray() - 2.45 minutes
5. QuickAndEasy() - 3.25 minutes
6. DeleteRowsWithValuesUnion() - Stopped after 5 minutes
.
Тест 2. Всего 1 миллион записей, 100 000 для удаления:
1. ExcelHero() - 16 seconds (average)
2. DeleteRowsWithValuesNewSheet() - 33 seconds (average)
3. DeleteRowsWithValuesStrings() - 4 hrs 38 min (16701.375 sec)
4. DeleteRowsWithValuesArray() - 4 hrs 37 min (16626.3051757813 sec)
5. QuickAndEasy() - 5 hrs 40 min (20434.2104492188 sec)
6. DeleteRowsWithValuesUnion() - N/A
.
Примечания:
- Метод ExcelHero: легко реализовать, надежно, очень быстро, но удаляет формулы.
- Метод NewSheet: легко реализуется, надежно и соответствует цели.
- Метод строк: больше усилий для реализации, надёжность, но не соответствует требованиям.
- Метод массива: аналогично строкам, но ReDims массив (более быстрая версия Союза)
- QuickAndEasy: легко реализовать (короткий, надежный и элегантный), но не соответствует требованиям.
- Range Union: сложность реализации аналогична 2 и 3, но слишком медленная
Я также сделал тестовые данные более реалистичными, введя необычные значения:
- пустые ячейки, диапазоны, строки и столбцы
- специальные символы, такие как = [`~! @# $% ^ & *() _- + {} []\|;: '",. < > /?, отдельные и множественные комбинации
- пробелы, вкладки, пустые формулы, границы, шрифт и другое форматирование ячейки.
- большие и малые числа с десятичными знаками (= 12.9999999999999 + 0.00000000000000001)
- гиперссылки, условные правила форматирования
- пустое форматирование внутри и вне диапазона данных
- все, что может вызвать проблемы с данными
