Удаление (скрытие) строк по условию

макрос удалит на листе все строки, в которых содержится искомый текст:

(пример - во вложении ConditionalRowsDeleting.xls)

Sub УдалениеСтрокПоУсловию()
    Dim ra As Range, delra As Range, ТекстДляПоиска As String
    Application.ScreenUpdating = False    ' отключаем обновление экрана

    ТекстДляПоиска = "Наименование ценности"    ' удаляем строки с таким текстом

    ' перебираем все строки в используемом диапазоне листа
    For Each ra In ActiveSheet.UsedRange.Rows
        ' если в строке найден искомый текст
        If Not ra.Find(ТекстДляПоиска, , xlValues, xlPart) Is Nothing Then
            ' добавляем строку в диапазон для удаления
            If delra Is Nothing Then Set delra = ra Else Set delra = Union(delra, ra)
        End If
    Next
    ' если подходящие строки найдены - удаляем их
    If Not delra Is Nothing Then delra.EntireRow.Delete
End Sub

Чтобы вместо удаления просто скрыть такие строки, замените строку

If Not delra Is Nothing Then delra.EntireRow.Delete

на

If Not delra Is Nothing Then delra.EntireRow.Hidden=TRUE

Расширенная версия этого макроса - с использованием UserForm для ввода искомого значения

(пример - в файле ConditionalRowsDeletingUsingUserform.xls)

Function ПоискСтрокПоУсловию(ByVal ТекстДляПоиска As String, Optional HideOnly As Boolean) As Long
    ' функция получает в качестве параметра ТекстДляПоиска (можно использовать символы * и ?)
    ' Если HideOnly = TRUE, то строки, содержащие в ячейках ТекстДляПоиска, скрываются,
    ' иначе (HideOnly = FALSE - по умолчанию) - удаляются
    ' Функция возвращает количество удалённых строк
    Dim ra As Range, delra As Range
    Application.ScreenUpdating = False    ' отключаем обновление экрана

    ' перебираем все строки в используемом диапазоне листа
    For Each ra In ActiveSheet.UsedRange.Rows
        ' если в строке найден искомый текст
        If Not ra.Find(ТекстДляПоиска, , xlValues, xlPart) Is Nothing Then
            ' добавляем строку в диапазон для удаления
            If delra Is Nothing Then Set delra = ra Else Set delra = Union(delra, ra)
        End If
    Next
    On Error Resume Next: ПоискСтрокПоУсловию = delra.Areas.Count ' количество найденных строк
    
    If Not delra Is Nothing Then    ' если подходящие строки найдены - скрываем или удаляем их
        If HideOnly Then delra.EntireRow.Hidden = True Else delra.EntireRow.Delete
    End If
End Function

Ещё один вариант кода, позволяющего выполнять поиск (с последующим удалением или скрытием строк) сразу по нескольким условиям:

Sub УдалениеСтрокПоНесколькимУсловиям()
    Dim ra As Range, delra As Range
    Application.ScreenUpdating = False    ' отключаем обновление экрана

    ' ищем и удаляем строки, содержащие заданный текст
    ' (можно указать сколько угодно значений, и использовать подстановочные знаки)
    УдалятьСтрокиСТекстом = Array("Наименование *", "Количество", _
                                  "текст?", "цен*сти", "*78*")
 
    ' перебираем все строки в используемом диапазоне листа
    For Each ra In ActiveSheet.UsedRange.Rows
        ' перебираем все фразы в массиве
        For Each word In УдалятьСтрокиСТекстом
            ' если в очередной строке листа найден искомый текст
            If Not ra.Find(word, , xlValues, xlPart) Is Nothing Then
                ' добавляем строку в диапазон для удаления
                If delra Is Nothing Then Set delra = ra Else Set delra = Union(delra, ra)
            End If
        Next word
    Next
 
    ' если подходящие строки найдены, то: (оставьте одну из 2 следующих строк)
    If Not delra Is Nothing Then delra.EntireRow.Hidden = True    ' скрываем их
    If Not delra Is Nothing Then delra.EntireRow.Delete    ' удаляем их
End Sub

Вложения:

ConditionalRowsDeleting.xls	24 КБ
ConditionalRowsDeletingUsingUserform.xls	45.5 КБ

246837 просмотров

Настройки просмотра комментариев

Выберите нужный метод показа комментариев и нажмите "Сохранить установки".

Mutabor, 24 Июн 2013 - 11:23.#1

Подскажите, пожалуйста, как сделать тоже самое только для столбцов на разных листах книги, т.е. нужно на всех листах книги удалить столбец по условию.

Галия, 21 Июн 2013 - 11:44.#2

Спасибо большое!

Игорь (администратор сайта), 19 Июн 2013 - 14:03.#3

Чтобы отобразить все строки перед повторным запуском макроса,
в его начало добавьте строку

rows.hidden = false ' отображаем все строки

Галия, по вашему вопросу:
а вы уверены, что в ячейке находятся дефисы?
Может, ячейки пустые, а дефис отображается, поскольку установлен такой формат ячейки?
Или там другой символ, с виду похожий на дефис (минус)...

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

Галия, 19 Июн 2013 - 13:52.#4

Здравствуйте! Подскажите, пожалуйста, вроде до идентичный, но не удаляет строки. В чем моя ошибка?
http://yadi.sk/d/Ys9V7Kd95yfRg

Гость, 19 Июн 2013 - 12:29.#5

А как сделать чтобы потом обратно строки отобразить, когда условия в этой строке поменяются (например поисковое слово изменится на другое известное конкретное слово)? Для меня сложность в том, что когда строка скрыта, то поиск в ней уже не происходит. Можно эту задачу решить?

Игорь (администратор сайта), 12 Июн 2013 - 04:30.#6

А вы почитайте внимательно статью, пролистав её до конца, - там же есть макрос для удаления строк по нескольким условиям.

Гость, 11 Июн 2013 - 19:14.#7

Здравствуйте подскажите пожалуйста как можно удалить несколько значении прим: он удаляет "яблоко", а мне надо чтоб удалил "яблоко","банан","апельсин" и т.д. если можно то сколько значений, заранее спасибо.

Гость, 19 Май 2013 - 17:53.#8

Пробовал макрос в коментах с Sat., San. удаляет только по полному совпадению. а мне например нужно удалить строки где в столбце "B" на конце номера стоит "ДЕФ", "Б/У", "REB" и тп.

Гость, 19 Май 2013 - 17:48.#9

Здравствуйте,
подскажите пожалуйста я использую макрос "УдалениеСтрокПоНесколькимУсловиям()" я вписал свои условия но мне нужно чтобы искал то что записано в Array не на всем листе а только в столбце "B".

Игорь (администратор сайта), 5 Апр 2013 - 16:04.#10

Почитайте комменты - там был пример кода.
Здесь, например: http://excelvba.ru/code/ConditionalRowsDeleting#comment-2020

Диапазон задается этой строкой:

Set ra = Range([d1], Range("d" & Rows.Count).End(xlUp)) ' весь столбец D

Можно написать так:

Set ra = Range("b2:h15") ' диапазон ячеек b2:h15

Гость, 5 Апр 2013 - 15:44.#11

Огромное спасибо! Всё работает! Подскажите ещё пожалуйста как указать конкретный диапазон для поиска значений, а не весь лист?

Игорь (администратор сайта), 27 Мар 2013 - 19:26.#12

А как добавить ещё четыре условия

Смотрите макрос УдалениеСтрокПоНесколькимУсловиям(), в котором можно через запятую перечислить сколько угодно условий.

И оставлять строки видимыми при соблюдении хотя бы одного из условий?

т.е. надо скрывать все строки, которые не подходят ни под одно условие?
тогда в конце макроса напишите:

If Not delra Is Nothing Then rows.hidden=true: delra.EntireRow.Hidden = false 
' скрываем все строки, после чего отображаем найденные строки

Гость, 27 Мар 2013 - 19:17.#13

Здравствуйте! А как добавить ещё четыре условия. И оставлять строки видимыми при соблюдении хотя бы одного из условий?

Игорь (администратор сайта), 4 Мар 2013 - 13:57.#14

Вот вам готовый макрос, под ваши требования:

Sub УдалениеСтрок()
    Dim ra As Range, delra As Range, cell As Range
    Set ra = Range([d1], Range("d" & Rows.Count).End(xlUp))
 
    Application.ScreenUpdating = False    ' отключаем обновление экрана
    
    ' перебираем все ячейки в столбце D, и выбираем только Sat и Sun
    ' заодно смотрим, чтобы ячейка справа (столбец E) была пустой
    For Each cell In ra.Cells
        If (cell = "Sat." Or cell = "Sun.") And cell.Next = "" Then
            ' добавляем ячейку в диапазон для удаления
            If delra Is Nothing Then Set delra = cell Else Set delra = Union(delra, cell)
        End If
    Next cell
 
    ' если подходящие строки найдены - удаляем их
    If Not delra Is Nothing Then delra.EntireRow.Delete
End Sub

Sergey, 4 Мар 2013 - 13:41.#15

Добрый день! Подскажите пожалуйста, как сделать:

Есть лист excel, в котором находятся данные. Необходимо удалить все строки, содержащие в столбце D ячейки с Sat. и Sun. Но если столбец E рядом не пустой, ячейку не нужно удалять. На приложенном примере в строке 40 рядом с Sat. есть данные, ее удалять не нужно. Остальные строки содержащие Sat. и Sun. нужно удалить по всему листу.

Буду очень благодарен за совет.

Вот пример: http://i.imgur.com/IZQR6QC.png

Гость, 29 Янв 2013 - 21:12.#16

Полезная опция, учту обязательно... Но выполняется макрос при клике на элемент ActiveX - CommandButton... Что интересно - проблему удалось решить методом научного попадания)))
с кодом: ThisWorkbook.Worksheets(1).Select 'стало работать как надо
но код: ThisWorkbook.Worksheets(1).Activate ' не помогал

Спасибо за участие!))

Игорь (администратор сайта), 29 Янв 2013 - 19:02.#17

John, тут нужно заметно переделывать макрос (а лучше сделать отдельную надстройку,
на скрытом листе которой будет храниться список условий)
иначе макрос будет тормозить.
К тому же, алгоритм поиска и удаления желательно изменить (или полностью переделать)

Я делал подобную надстройку
Постараюсь в ближайшее время опубликовать её на сайте.

John, 29 Янв 2013 - 18:56.#18

Как изменить макрос, чтобы задавать условия для удаление строк столбцом значений
Всего около 4000 значений, которые прописаны столбцом

Игорь (администратор сайта), 27 Янв 2013 - 23:38.#19

А вы макрос запускаете случайно не с формы?
Если в этот момент отображается форма - то она и останется активной.
Чтобы передать фокус ввода листу Excel, надо выполнить следующий код:

AppActivate Application.Name ' передаем фокус листу Excel

Гость, 27 Янв 2013 - 23:31.#20

Вы все правильно поняли, в том то и "глюк" что отображается лист Worksheets(list), но он не активный, только при "клике" на вкладке Worksheets(list) он начинает функционировать не смотря на то что уже отображается на мониторе... Наверное я что то перемудрил с макросами, либо что то с компьютером...
Все же спасибо за совет!

Игорь (администратор сайта), 27 Янв 2013 - 20:21.#21

Как-то слишком запутанно вы все описали...

монитор отображает лист Worsheets(list), при чем, активным остается все равно Worsheets(1)

Какой лист активный — тот и отображается на мониторе. Разве нет?
А с ваших слов, активный и отображаемый лист различаются.
Или вы что-то путаете, или я вас неправильно понял.

Попробуйте так: (хотя и в вашем коде ошибок не было)

    On Error Resume Next
    If MsgBox("Удалить """ & nazvanie & """?", vbYesNo) = vbYes Then
        ThisWorkbook.Worksheets(List).Range("A:A").Find(nazvanie, , xlValues, xlPart).EntireRow.Delete
    End If

Если надо с первого листа удалять, а не с листа List,
то замените List на 1

Если надо активировать какой-то лист, допишите ниже

    ThisWorkbook.Activate ' сначала активируем книгу (если вдруг открыто несколько книг)
    Worsheets(1).Activate ' а потом уже активируем лист

Гость, 27 Янв 2013 - 19:30.#22

помогите Пжалста(((
надо удалить строки на другом листе...

With ThisWorkbook.Worksheets(list)
Set ra = .Range("A:A")
If MsgBox("Удалить " & Chr(34) & nazvanie & Chr(34) & "?", vbYesNo) = vbYes Then
rw = ra.Find(nazvanie, , xlValues, xlPart).Row: .Rows(rw).Delete
End If
End With

срабатывает все верно, только мы работаем с Worsheets(1), а монитор отображает лист Worsheets(list), при чем, активным остается все равно Worsheets(1)... Worsheets(1).Activate не помогает...
может я чего неправильно прописал???

Гость, 23 Янв 2013 - 17:27.#23

в вашем случае я бы использовала обычную команду "найти и заменить". В поле 'найти' укажите " /" (пробел и /) а в поле 'заменить' не ставьте ничего, нажмите на "заменить" и все ваши ненужные знаки исчезнут

Гость, 8 Янв 2013 - 07:55.#24

Огромнейшее Вам спасибо за макрос!!! Как по взмаху волшебной палочки исчезло несколько сотен ненужных строк, что избавило меня от паручасового тыканья.

Игорь (администратор сайта), 25 Дек 2012 - 12:00.#25

liubov, а зачем вам вообще этот макрос?
Макрос предназначен для удаления\скрытия СТРОК целиком, а не для отдельных символов.

Нажмите Ctrl + H (или в меню Правка - Заменить),
в поле «Что заменить» введите пробел и /
а поле «На что заменить» оставьте пустым

Нажатие кнопки «Заменить все» решит вашу проблему.

liubov, 25 Дек 2012 - 11:52.#26

добрый день, а подскажите пожалуйста, если мне надо удалять не строку, а значения в ячейке, например 89 /265 мне нужно чтобы после удаления осталось 89265 удаляя везде "пробел и /".и так весь столбец более тысячи строк, каждый раз меняющиеся

Александр, 5 Ноя 2012 - 14:30.#27

Игорь, благодарю!!! Непременный принцип грядущего Золотого века "Хорошо и мне, и людям" у тебя действует на 100%! А вот и то, что нужно мне - поиск происходит только в одном столбце, и макрос скрывает все строки, которые не имеют текста.
Sub СкрытиеСтрок()
Dim cell As Range: Application.ScreenUpdating = False
For Each cell In [b6:b2000].Cells
' скрываем строку, если в колонке b пусто
If cell.Find("*", , xlValues, xlPart) Is Nothing Then
cell.EntireRow.Hidden = True
End If
Next cell
End Sub

Игорь (администратор сайта), 13 Сен 2012 - 22:04.#28

Анастасия, я не совсем понял, в чем проблема.
Если формулы возвращают нулевые значения, то мой макрос должен работать - скрывать строки
(макросу не важно, в ячейке 0 оказался в результате ручного ввода, или в результате вычисления формулы)
Если что-то не получается - высылайте файл мне на почту, или обратитесь на форумы по Excel (там покажут, как сделать, на примере вашего файла)

Анастасия, 13 Сен 2012 - 20:33.#29

Уважаемый администратор. Прошу помочь в сложившейся ситуации.
У меня создана книга в Excel. Первый лист - Список товаров. Второй лист - реализация. Третий лист - Остаток товара. Мне нужно скрыть с помощью макроса те строки, остаток товара которых равен нулю. Но в ячейках получается не просто значение 0, а формула (напр. ='Список товаров'!C2-Реализация!C2).
Как стоит поступить в этом случае?

Игорь (администратор сайта), 19 Июл 2012 - 15:28.#30

Я пишу макросы под заказ (что подразумевает оплату). Если готовы оплатить помощь - оформляйте заказ на сайте.
Если хотите бесплатно - обратитесь на любой из форумов по Excel.

Саша, 19 Июл 2012 - 13:13.#31

Добрый день. Помогите с макросом, который бы удовлетворял следующему условию: нужно что бы он удалял пустые столбцы, но что бы начинал "просмотр" на наличие значений не с 1й строки, а со 2й, т.е если есть значение в ячейке "А1", а ниже нет ничего, то он удалял столбец "А". Спасибо

Гость, 13 Июн 2012 - 15:36.#32

День добрый. Нужна помощь. Устроился на работу в магазин и тут же дали задание сделать прайс лист с макросом чтоб удалялись пустые строки. Помогите пожалуйста. напишите на почту я пришлю файл. Я ВООБЩЕ не знаю как работать с макросами. Работа очень нужна.kot134@mail.ru

Игорь (администратор сайта), 7 Июн 2012 - 14:16.#33

Здравствуйте, Анна.

Поместите этот код в модуль ЭтаКнига:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    ' этот макрос автоматически сработает перед закрытием книги
    ОтобразитьВсеСтроки    ' или ОтобразитьВсеСтрокиНаВсехЛистах
    ThisWorkbook.Save    ' принудительно сохраняем файл
End Sub
 
 
Sub ОтобразитьВсеСтроки()
    ' сработает только для текущего листа
    Cells.EntireRow.Hidden = False
End Sub
 
Sub ОтобразитьВсеСтрокиНаВсехЛистах()
    Dim sh As Worksheet
    For Each sh In ThisWorkbook.Worksheets
        sh.Cells.EntireRow.Hidden = False
    Next sh
End Sub

Анна, 7 Июн 2012 - 13:06.#34

Огромное спасибо за макрос. Мой вопрос: возможно ли перед закрытием файла отменить удаление (сокрытие) строк?
Мне нужно распечатать бланк и убрать из него пустые позиции, но сохранить все данные в книге, в которой много листов - в базе ответов.

Андрей, 6 Июн 2012 - 14:26.#35

Спасибо - все работает. Если можно, еще такой момент. В моем случае речь о товарной накладной и если в наименовании товара будет "Наименование ценности" (в моем случае "Итого на листе") то эта строчка, как я понимаю, удалится. Как можно сузить поиск до 1 колонки. Чтобы макрос искал "Итого на листе" только по колонке "К" и если находил, то удалял эту строчку и следующую за ней?

Игорь (администратор сайта), 6 Июн 2012 - 13:57.#36

Чтобы удалялись не только найденные строки, и следующие за ними ниже,
замените в коде строку

If delra Is Nothing Then Set delra = ra Else Set delra = Union(delra, ra)

на

If delra Is Nothing Then Set delra = ra.Resize(2) Else Set delra = Union(delra, ra.Resize(2))

Андрей, 6 Июн 2012 - 13:46.#37

Спасибо за мануал. Подскажите пжл. как можно удалить не только строку, где
ТекстДляПоиска = "Наименование ценности", но и следующую за ней.

Сергей, 14 Май 2012 - 12:06.#38

Дело в том, что для меня это как китайские письмена))

Игорь (администратор сайта), 14 Май 2012 - 11:58.#39

Здравствуйте, Сергей.
Конечно можно и UserForm прикрутить, и вообще что угодно.
Примеров в статье и комментах - предостаточно. Думаю, у вас без проблем получится всё это сделать.

Сергей, 14 Май 2012 - 11:33.#40

Добрый день!

Для меня очень полезен макрос для удаления строк, не содержащих заданные текстовые строки (пост №10). Подскажите, можно ли к нему прикрутить UserForm для выбора значения поиска?

Гость, 8 Май 2012 - 19:26.#41

А как сделать чтобы поиск происходил только в одном столбце,
и скрывал все строки которые не имеют заданного текста
Спасибо

Игорь (администратор сайта), 11 Апр 2012 - 06:43.#42

Xroute, макрос мой (да и вообще макросы) в этом случае не нужны.
Это очень просто делается при помощи простейших формул типа =если(), =И(), =СЧЁТЕСЛИ() и т.п.

Обратитесь на форум со своим файлом - вам помогут с формулами
(достаточно написать формулы для одной строки, а потом протянуть мышом эти формулы на нужное количество строк)

Xroute, 11 Апр 2012 - 02:01.#43

за основу взят Ваш макрос, таблица проста.

| Иванов | 1 | 0 | 4 | 6 | 15 | 11 | 5 | 14 | 0 |

только Вы удаляете строки, а мне надо пробежаться по таблице и в строках выявить совпадения из условий, условий допустим 3 или более. т.е если в строке, в какой-либо ячейки содержится число 4, то пишем в конец строки (14 ячейка) user, если в той же строке содержится число 1 - то пишем в 15 ячейку - megauser, и последнее, если в строке содержится и 5,11,14(порядок может быть любой, и они могут идти через 1 значение или в перемешку с другими, но компановка в строке 5,11,14 дает 1 значение) то пишем admin в 16 ячейку. грубо говоря в строке могут быть выполены все условия, а могут и не все. копи-пастом не вариант. слишком много строк. задача стоит именно в экселе, хотя на шарпе я это уже сделал, а вот в VB что-то не получается (

вот что должно получиться на выходе

| Иванов | 1 | 0 | 4 | 6 | 15 | 11 | 5 | 14 | 0 | | user | | Megauser | | Admin |

как-то так.

Спасибо.

Игорь (администратор сайта), 10 Апр 2012 - 10:08.#44

Xroute, дублировать код макроса не надо.
Увы, подсказать, как именно лучше сделать, не могу, - не видя весь ваш код, сложно понять,
что именно вы хотите сделать.
Обратитесь на любой форум по Excel, прикрепив свой файл с кодом, - вам помогут.

Xroute, 10 Апр 2012 - 07:39.#45

Спасибо, очень помогли, но появился еще один, не менее глупый вопрос.
Можно делать вставку значений, в зависимости от переменной?
т.е
ver1 = Array("hello")
ver2 = Array("world")
и так далее, а потом форычем...но если честно - не получилось.
получилось в говнокоде, если каждый раз переназначать переменную и дублировать сам код макроса, а это не есть гут.

есть вариант скомпоновать и сделать красиво?

Спасибо.

Игорь (администратор сайта), 10 Апр 2012 - 04:43.#46

Замените последнюю строку макроса на это:

    ' если подходящие строки найдены - меняем у них 14-ю ячейку на "test"
    If Not delra Is Nothing Then Intersect(delra.EntireRow, Columns(14)).value = "test"

А синтаксис у VB очень даже дружелюбный, если в нём разбираешься )

Гость, 10 Апр 2012 - 03:51.#47

Спасибо за макрос.
Не подскажите, как сделать, чтоб строки не удалялись, а допустим в конец строки ( или конкретную 14 ячейку текущей строки, где было найдено совпадение) вставлялось значение "test".
VB увидел 1й раз, какой-то синтаксис не очень дружелюбный ((

Спасибо.

Дмитрий, 8 Мар 2012 - 10:03.#48

Добрый день!

Отличный макрос, но ещё необходимо что-бы он мог не только скрывать, но и раскрывать строки. И, желательно, иметь для этого пару кнопок в ленте. Это возможно?

Сергей, 26 Фев 2012 - 00:22.#49

Спасибо огромное за помощь!

Игорь (администратор сайта), 25 Фев 2012 - 20:46.#50

Этот макрос переберёт все строки в заданном диапазоне, и скроет те из них, у которых ни одна ячейка не заполнена данными:

Sub СкрытиеПустыхСтрок()
    Dim ro As Range, delra As Range
    Application.ScreenUpdating = False    ' отключаем обновление экрана

    ' перебираем все строки в диапазоне с 1-й по 150-ю
    For Each ro In Range("1:150").EntireRow
        ' если в строке НЕ найден любой текст
        If ro.Find("*", , xlValues, xlPart) Is Nothing Then
            If delra Is Nothing Then Set delra = ro Else Set delra = Union(delra, ro)
        End If
    Next
    ' если подходящие строки найдены - удаляем их
    If Not delra Is Nothing Then delra.EntireRow.Hidden = True
End Sub

Удаление (скрытие) строк по условию

Комментарии

Настройки просмотра комментариев

НАДСТРОЙКИ ДЛЯ EXCEL