Добрый день, Уважаемые специалисты! Я не могу прикрепить тут файл своей таблицы, т.к.он весит 2,5 мегабайтов, могу выслать на почту. Попробую описать проблему: таблица состоит из 9 столбцов с шапками, причём во втором столбце слева таблицы есть очень много объединённых ячеек по 2 штуки. В третьем столбце есть ячейки со значением БУ и Кол., причём они расположены поочерёдно друг за другом (приложил фрагмент файла, но структура удалена). Задача вроде бы и простая, но что-то мешает. Суть задачи: надо удалить те строки полностью, где в столбце №3 есть ячейки со значением БУ. Проблему я решал, но ничего не получилось. Сперва я убрал структуру, потом решил убрать в столбце №2 объединённые ячейки, разъединив их и на этом этапе и споткнулся. Может быть кто-то подскажет поэтапно, как справиться с задачей? Макрос тут скорее всего изза объединённых ячеек не поможет.
Спасибо заранее!
Добрый день, Уважаемые специалисты! Я не могу прикрепить тут файл своей таблицы, т.к.он весит 2,5 мегабайтов, могу выслать на почту. Попробую описать проблему: таблица состоит из 9 столбцов с шапками, причём во втором столбце слева таблицы есть очень много объединённых ячеек по 2 штуки. В третьем столбце есть ячейки со значением БУ и Кол., причём они расположены поочерёдно друг за другом (приложил фрагмент файла, но структура удалена). Задача вроде бы и простая, но что-то мешает. Суть задачи: надо удалить те строки полностью, где в столбце №3 есть ячейки со значением БУ. Проблему я решал, но ничего не получилось. Сперва я убрал структуру, потом решил убрать в столбце №2 объединённые ячейки, разъединив их и на этом этапе и споткнулся. Может быть кто-то подскажет поэтапно, как справиться с задачей? Макрос тут скорее всего изза объединённых ячеек не поможет.
Ставьте автофильтр Зафильтруйте строки, которые нужно удалить Выделите всю таблицу до конца (кроме шапки) Нажмите Shift + пробел - это выделит всю строку Нажмите Alt + ж - это выделит только видимый диаппазон Нажмите Ctrl + - - это удалит выделенные строки Снимите фильтр Все
Поправка. Если нужно сохранить подписи эти действия сделайте сначала: Выделите столбец с объединенными ячейками отмените объединение F5 Alt +вй Enter = + стрелка вверх, Ctrl + Enter Выделите столбец с объединенными ячейками Ctrl + с правой кнопкой мыши вставить значения.
На все про все уходит секунд 20
Ставьте автофильтр Зафильтруйте строки, которые нужно удалить Выделите всю таблицу до конца (кроме шапки) Нажмите Shift + пробел - это выделит всю строку Нажмите Alt + ж - это выделит только видимый диаппазон Нажмите Ctrl + - - это удалит выделенные строки Снимите фильтр Все
Поправка. Если нужно сохранить подписи эти действия сделайте сначала: Выделите столбец с объединенными ячейками отмените объединение F5 Alt +вй Enter = + стрелка вверх, Ctrl + Enter Выделите столбец с объединенными ячейками Ctrl + с правой кнопкой мыши вставить значения.
Sub U_01() Range(Cells(1, 2), Cells(Rows.Count, 2).End(xlUp)).UnMerge For Each c In Range(Cells(1, 2), Cells(Rows.Count, 2).End(xlUp)) If c = "" Then c.Cells = c.Offset(-1, 0) End If Next
With ThisWorkbook.Worksheets("Лист1").Range(Cells(1, 3), Cells(Rows.Count, 3).End(xlUp)) Set Rng = .Find("БУ", , LookIn:=xlValues, lookat:=xlWhole) If Not Rng Is Nothing Then Do Rng.EntireRow.Delete Set Rng = .FindNext() Loop While Not Rng Is Nothing End If End With
End Sub
[/vba]
[vba]
Код
Sub U_01() Range(Cells(1, 2), Cells(Rows.Count, 2).End(xlUp)).UnMerge For Each c In Range(Cells(1, 2), Cells(Rows.Count, 2).End(xlUp)) If c = "" Then c.Cells = c.Offset(-1, 0) End If Next
With ThisWorkbook.Worksheets("Лист1").Range(Cells(1, 3), Cells(Rows.Count, 3).End(xlUp)) Set Rng = .Find("БУ", , LookIn:=xlValues, lookat:=xlWhole) If Not Rng Is Nothing Then Do Rng.EntireRow.Delete Set Rng = .FindNext() Loop While Not Rng Is Nothing End If End With
Nic70y, спасибо Вам и всем, кто дал советы. Я вставил в окно макроса код, но при запуске он сообщил об ошибке... Вот что получилось: [vba]
Код
Sub W() U_01() Range(Cells(1, 2), Cells(Rows.Count, 2).End(xlUp)).UnMerge For Each c In Range(Cells(1, 2), Cells(Rows.Count, 2).End(xlUp)) If c = "" Then c.Cells = c.Offset(-1, 0) End If Next
With ThisWorkbook.Worksheets("Ëèñò1").Range(Cells(1, 3), Cells(Rows.Count, 3).End(xlUp)) Set Rng = .Find("ÁÓ", , LookIn:=xlValues, lookat:=xlWhole) If Not Rng Is Nothing Then Do Rng.EntireRow.Delete Set Rng = .FindNext() Loop While Not Rng Is Nothing End If End With End Sub
[/vba] Как правильно воспользоваться Вашим кодом? [moder]Оформляйте коды тегами (кнопка #)[/moder]
Nic70y, спасибо Вам и всем, кто дал советы. Я вставил в окно макроса код, но при запуске он сообщил об ошибке... Вот что получилось: [vba]
Код
Sub W() U_01() Range(Cells(1, 2), Cells(Rows.Count, 2).End(xlUp)).UnMerge For Each c In Range(Cells(1, 2), Cells(Rows.Count, 2).End(xlUp)) If c = "" Then c.Cells = c.Offset(-1, 0) End If Next
With ThisWorkbook.Worksheets("Ëèñò1").Range(Cells(1, 3), Cells(Rows.Count, 3).End(xlUp)) Set Rng = .Find("ÁÓ", , LookIn:=xlValues, lookat:=xlWhole) If Not Rng Is Nothing Then Do Rng.EntireRow.Delete Set Rng = .FindNext() Loop While Not Rng Is Nothing End If End With End Sub
[/vba] Как правильно воспользоваться Вашим кодом? [moder]Оформляйте коды тегами (кнопка #)[/moder]strimax
Сообщение отредактировал Pelena - Среда, 11.11.2015, 07:38
SLAVICK, спасибо Вам за подробный ответ, но у меня не получается выполнить как Вы написали. Где-то что-то не идёт... Например, правой кнопкой мыши вставить значения - ничего не вставляется правой кнопкой мыши, а во всех ячейках появляются нули, объединение не пропадает. Может это связано с тем, что таблица преобразована из структуры в обычную? [moder]Бездумное цитирование запрещено Правилами форума. Замечание Вам[/moder]
Цитата удалена
SLAVICK, спасибо Вам за подробный ответ, но у меня не получается выполнить как Вы написали. Где-то что-то не идёт... Например, правой кнопкой мыши вставить значения - ничего не вставляется правой кнопкой мыши, а во всех ячейках появляются нули, объединение не пропадает. Может это связано с тем, что таблица преобразована из структуры в обычную? [moder]Бездумное цитирование запрещено Правилами форума. Замечание Вам[/moder]strimax
Сообщение отредактировал Pelena - Среда, 11.11.2015, 07:40
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
