Макрос для удаления строки

[IgorGO]

а все равно надо будет "скучным" циклом по всему пройтись (см. Do ... Loop) с помощью Union собрать в один диапазон
а потом уже весело одной командой удалить.

вот скучный цикл делает то что написано в названии.

Sub Del_3_From_B()
  On Error Resume Next
  Columns("B").Find(what:=3, LookAt:=xlWhole).EntireRow.Delete
  Do
    Columns("B").FindNext.EntireRow.Delete
  Loop Until Err.Number > 0
  Err.Clear: On Error GoTo 0
End Sub

если еще в начале запретить обновление экрана, автоматический пересчет, а в конце процедуры разрешить это все, то
затрудняюсь сказать вообще вы уловите разницу в продолжительности работы этих процедур при удалении 1000 строк, не говоря о 10-20 штуках.

[SAS888]

есть таблица 10 столбцов и дофига строк(2000-3000),
ну так вот из нее нужно удалить
строки в которых хотя-бы одна из десяти ячеек пустая

задача такая - надо удалить несколько строк. Циклом - скучно...

Согласен. Чтобы не скучать, можно без цикла:

Sub DelRows()
    On Error Resume Next
    Intersect(ActiveSheet.UsedRange, [A1:J2000].SpecialCells(xlCellTypeBlanks).EntireRow).Delete
End Sub

Здесь [A1:J2000] - это контролируемый диапазон. А On Error Resume Next - это на случай, если в этом диапазоне нет ни одной пустой ячейки.


P.S. Забыл пояснить, что если в одной строке диапазона найдется несколько пустых ячеек, то использовать ...SpecialCells(xlCellTypeBlanks).E ntireRow.Delete не получится, т.к. данная команда неприменима к пересекающимся диапазонам. Именно поэтому в коде применено получение нового "чистого" диапазона с помощью Intersect...

[leech]

Я вобщето про случай проще спрашивал. Так что все таки понял как можно без циклов
Просто удалить несколько строк "от меня и до следующего дуба". Без всяких дополнительных условий, только как в Rows("1:200").Delete вместо явного указания 1-й и последней строки поставить переменные? До сегодня использовал For... Next и удалял по 1 строке...
Вот осенило наконец. Может кому еще поможет совсем начинающему. Пример удаления 200 строк без цикла:

Sub nRowDelete()
Dim DelRows As String
Dim RowFirst As Integer, RowEnd As Integer

RowFirst = 1 'первая строка для удаления
RowLast = 200 'последняя строка
DelRows = RowFirst & ":" & RowLast
Rows(DelRows).Delete
End Sub

[S63AMG]

Здравствуйте!
Пожалуйста помогите сделать макрос для "производственных задач"
Дано: массив - 6 столбцов, около 1000 строк.
Задача макроса: удалять строки, в которых есть только одна пустая ячейка (она всегда находится в 5 столбце).
Если же в строке больше чем 1 пустая ячейка (например 2 рядом) - оставлять строку нетронутой.

Благодарю за помощь.

[IgorGO]

Sub DelBlank()
  For r = UsedRange.Rows.Count + UsedRange.Row - 1 To UsedRange.Row Step -1
    If Cells(r, 5) = "" Then
      n = 0
      For c = 1 To 6: If Cells(r, c) = "" Then n = n + 1: Next
      If n = 1 Then Rows(r).Delete
    End If
  Next
End Sub

[SAS888]

Видимо, уважаемый IgorGO очень куда-то спешил.
1. При обращении к используемому диапазону рабочего листа, лист нужно указывать обязательно. Т.е. не просто UsedRange, а, например, ActiveSheet.UsedRange. Иначе будет ошибка.
2. Разделять операторы, записывая их в одну строку, знаком ":" можно, но не всегда. Так, например, нельзя использовать в одной строке For и If:
For c = 1 To 6: If Cells(r, c) = "" Then n = n + 1: Next - будет ошибка.
3. При последовательном удалении строк, целесообразно запрещать изменение экрана: Application.ScreenUpdating = False

Предлагаю другой вариант, в котором перебираются не все строки листа, а только те, в 5-м столбце (столбце "E") которых пусто. Причем, ячейки в этих строках вообще не перебираются (что существенно быстрее). Затем контролируем, есть ли еще пустые ячейки в таблице. И, если нет, то формируем диапазон строк листа для последующего удаления. Удаление всех полученных строк осуществляется с помощью 1-й команды. Поэтому, это, во-первых, существенно быстрее, во-вторых, запрещать изменение экрана ни к чему.

Sub DelBlank2()
    Dim x As Range, y As Range
    For Each x In Intersect(ActiveSheet.UsedRange, [E:E].SpecialCells(xlCellTypeBlanks).EntireRow).Rows
        If Application.CountA(x) = ActiveSheet.UsedRange.Columns.Count - 1 Then _
        If y Is Nothing Then Set y = x Else Set y = Union(y, x)
    Next
    If Not y Is Nothing Then y.EntireRow.Delete
End Sub

[S63AMG]

Спасибо большое SAS888 и IgorGO за столь оперативную помощь! Воспользовался в итоге кодом SAS888. Очень помогло автоматизировать нудные операции
Однако еще очень важный вопрос: возможно ли этот макрос модифицировать, чтобы он удалял строки с ячейками, в которой содержится только один тег <br> и далее пустота?
Например в прикрепленной базе это строки с пустыми ячейками №58-61 и также строки №89-91.
Заранее спасибо за помощь

[SAS888]

S63AMG, на сколько я понял, в 4-м столбце пустые значения и "0" считается равнозначным. Тогда можно так:

Sub Main()
    Application.ScreenUpdating = False: Rows(1).AutoFilter
    ActiveSheet.[A:A].AutoFilter Field:=5, Criteria1:="=<br>", Operator:=xlOr, Criteria2:="="
    ActiveSheet.[A:A].AutoFilter Field:=4, Criteria1:="<>0"
    Intersect(ActiveSheet.UsedRange, Rows("3:" & Rows.Count)).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    Rows(1).AutoFilter: Application.ScreenUpdating = True
End Sub

Пример во вложении. Запустите макрос "Main".

[S63AMG]

Хм, нет, уважаемый SAS888. Пустые значения и нули в 4 столбце вовсе не равнозначны Привязки содержимого ячейки (с одним тегом) из 5 столбца к содержимому соседней ячейки нет никакой. т.е. смело можно удалять строки в которых соседствуют ячейки с тегом и ячейки 4-го столбца с любыми числами от 0 до R.
Вот есть такое решение, работает верно:

Sub Макрос1()
On Error Resume Next
Application.ScreenUpdating = 0
r_ = Range("A" & Rows.Count).End(xlUp).Row
    Range("A1").CurrentRegion.AutoFilter
    Selection.AutoFilter Field:=1, Criteria1:="<>"
    Selection.AutoFilter Field:=2, Criteria1:="<>"
    Selection.AutoFilter Field:=3, Criteria1:="<>"
    Selection.AutoFilter Field:=4, Criteria1:="<>"
    Selection.AutoFilter Field:=6, Criteria1:="<>"
Selection.AutoFilter Field:=5, Criteria1:="=", Operator:=xlOr, Criteria2:="=<br>"
    Range("A2:A" & r_).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    Selection.AutoFilter
Application.ScreenUpdating = 1
On Error GoTo 0
End Sub

[SAS888]

Ну, значит я Вас не верно понял.
По поводу Вашего макроса: я бы не стал использовать CurrentRegion, т.к. если, например, в середине таблицы встретится пустая строка, то макрос отработает не верно. Надежнее заменить

Range("A1").CurrentRegion.AutoFilter

на

[A:F].AutoFilter

и в дальнейшем коде использовать не Selection, а [A:F]