| Цитата |
|---|
| 3. Можно вспомнить и про Offset, CurrentRegion, SpecialsCells, UsedRange и проч. |
Offset, CurrentRegion - c этим всё понятно.
SpecialCells интересен в плане быстрого удаления отфильтрованных данных. Напишу про это.
Часто многим требуется удалить из таблицы какие-то строки, в одном из столбцов которых находятся нужные значения.
Кто-то делает циклом, кто-то через Find. Согласен, что им есть место, но в случае больших таблиц всё-таки быстрее метод с автофильтром.
Как он работает.
Возьмём, к примеру, диапазон
A1: G5000. Итак, я знаю строку, с которой начинается таблица (исключая заголовок, где, собственно, и стоит фильтр). Далее, определяю последнюю строку (получаю 5000) и храню в переменной. После этого фильтрую данные. А далее использую SpecialCells и Delete:
| Код |
|---|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 | Sub QuickRemove()
Dim lastRow As Long, rng As Range, rngVisible As Range
Call ResetAutoFilter(ActiveSheet)
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
Range("A1:G1").AutoFilter Field:=3, Criteria1:=555
On Error Resume Next
Set rngVisible = Range("A2:G" & lastRow).SpecialCells(xlCellTypeVisible)
If Err = 0 Then
rngVisible.Delete 3
Else
MsgBox Err.Description
Err.Clear
End If
End Sub
|
|
Такого же эффекта можно добиться ещё меньшим количество строк (да и код более элегантный получается
). Идея - в комментарии.
| Код |
|---|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 | Sub AnotherQuickRemove()
Dim rngVisible As Range
Call ResetAutoFilter(ActiveSheet)
Range("A1:G1").AutoFilter Field:=3, Criteria1:=12
On Error Resume Next
With ActiveSheet.AutoFilter.Range
Set rngVisible = .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible)
End With
If Not rngVisible Is Nothing Then
rngVisible.Delete 3
Else
MsgBox Err.Description
Err.Clear
End If
End Sub
|
|
В процедуре используется вспомогательная процедура "ResetAutoFilter", которая сбрасывает каждый фильтр и не удаляет сам фильтр с листа (может, кому пригодится
):
| Код |
|---|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 | Sub ResetAutoFilter(sheet As Worksheet)
Dim fs As Filters, rng As Range, i As Integer
With sheet
If .AutoFilterMode Then
With .AutoFilter
Set fs = .Filters
Set rng = .Range
End With
For i = 1 To fs.Count
If fs(i).On Then rng.AutoFilter i
Next
End If
End With
End Sub
|
|
UsedRange удобно использовать для удаления "невидимого" форматирования, которое влияет на размер полос прокрутки (когда полоса прокрутки "говорит", что на листе много строк/столбцов, в то время как их очень мало).
