Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Макрос для удаления значений из строк по определенному критерию, и удаления (смещения) образовавшихся пустых строк
 
#1
21.05.2017 18:44:34
Здравствуйте, уважаемые форумчане! Помогите, пожалуйста, написать макрос. Суть такая:
Есть табличка, с таким диапазоном - A6:F505. Туда будут копироваться данные из другой программы. Нужен макрос (под кнопку из фигуры), который будет очищать данные в каждой строке данного диапазона, если хотя бы одна ячейка данной строки пустая. То есть, допустим, если в строке A6:F6 есть хотя бы одна пустая ячейка, то должна очищаться вся строка (имею в виду не удаление строки, а удаление данных из всех ячеек этой строки).
А затем, чтобы образовавшиеся пустые строки тоже удалялись. Опять же, желательно не удаление всей строки, а каким-то другим способом это делать... Возможно, сдвиг значений из нижерасположенной строчки или еще как-то. Главное, чтобы в таблице осталось фиксированное число строк, именно в этом диапазоне и именно с конкретной стилистикой. И все это действие должно происходить на одном листе.
Если такое можно сделать без 100 грамм и десятков часов кропотливой работы, был бы очень признателен))

Пример прилагаю. Там на листе1 выборка исходных данных, а на листе2 то, что должно получиться после работы макроса.
 
 
 
#2
21.05.2017 18:59:21
Код
Sub DelRowsWithBlankCell()
  On Error Resume Next
  Range("A6:F505").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
 
 
#3
21.05.2017 19:04:16
Цитата
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
Этот макрос все же удаляет пустые строки, а нужно, чтобы не удалял, а сдвигал значения из последующей строки на пустую (если такое возможно). Грубо говоря, чтобы между первой и последней строчкой таблицы не было пустых строк. Ну а в целом, если не получится осуществить задуманное, возьму Ваш макрос, спасибо.
Изменено: flashertheone - 21.05.2017 19:06:21
 
 
 
#4
21.05.2017 19:21:16
добавим пару строк:
Код
Sub DelRowsWithBlankCell()
  Dim rg As Range:  On Error Resume Next
  With Range("A6:F505").SpecialCells(xlCellTypeBlanks).EntireRow
    If Err = 0 Then .ClearContents: .Copy Cells(506, 1): .Delete
  End With
End Sub
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
 
 
#5
21.05.2017 19:29:29
Цитата
flashertheone написал:
если в строке A6:F6 есть хотя бы одна пустая ячейка, то должна очищаться вся строка (имею в виду не удаление строки, а удаление данных из всех ячеек этой строки).
А затем, чтобы образовавшиеся пустые строки тоже удалялись.
Если в итоге эта строка удаляется, то зачем нужна её предварительная очистка?
 
 
 
#6
21.05.2017 19:39:16
Ігор Гончаренко
Почти то, что надо, но, похоже, придется добавить еще пару строк)))
До применения макроса все строки, начиная с 506-ой были скрыты, а после - открылись все...
Все бы ничего, но требуется сохранить нужную стилистику таблицы, в том числе и количество скрытых строк.
То есть, Вашему макросу надо бы добавить команду, чтобы он скрывал опять все строки, начиная с 506-ой. Ну или поменять алгоритм его выполнения, тут я не знаю, как Вам удобнее...

Юрий М
Вы выдернули из контекста отрывок, не дочитав до конца =)
Я писал :
Цитата
А затем, чтобы образовавшиеся пустые строки тоже удалялись. Опять же, желательно не удаление всей строки, а каким-то другим способом это делать...
 
 
 
#7
21.05.2017 19:45:21
Нет, я дочитал ))
Цитата
flashertheone написал:
образовавшиеся пустые строки тоже удалялись. Опять же, желательно не удаление всей строки, а каким-то другим способом это делать
Вот это никак не могу понять: строка или удаляется совсем (тогда не нужна очистка), или не удаляется )
Покажите в своём файле таблицу ДО и ПОСЛЕ.
 
 
 
#8
21.05.2017 19:47:35
3-й вариант... зачетный
Код
Sub DelRowsWithBlankCell()
  Dim rg As Range: On Error Resume Next
  With Range("A6:F505").SpecialCells(xlCellTypeBlanks).EntireRow
    If Err = 0 Then .ClearContents: Intersect(.Cells, Range("A:F")).Copy Cells(506, 1): .Delete
  End With
End Sub
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
 
 
#9
21.05.2017 19:49:03
Юрий М
Строка не удаляется.
В примере таблицы именно так и показано =)
Как было 500 открытых строк (A6:F505), так и должно остаться, с сохранением стилей.
 
 
 
#10
21.05.2017 19:52:12
Цитата
flashertheone написал:
Строка не удаляется.
В примере таблицы именно так и показано =)
В примере есть две строки с жёлтыми ячейками. Это ДО. А КАК должно получится ПОСЛЕ?
Впрочем, если Игорь понял объяснения, то можно на мой вопрос не отвечать :)
 
 
 
#11
21.05.2017 19:54:38
Цитата
3-й вариант... зачетный
Эффект тот же, что и от второго варианта, не скрывает лишние строки...
 
 
 
#12
21.05.2017 20:00:06
flashertheone,
откройте исходный файл, посмотрите а строку 506, она видна?
выполните макрос, что в файле после выполнения макроса стало не не так как ожидалось?
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
 
 
#13
21.05.2017 20:05:11
Ігор Гончаренко

Исходный файл или пример, который я прикрепил?
Я выполняю каждый Ваш макрос и смотрю результат.
После выполнения последнего макроса видна и 506-я строка и последующие...
 
 
 
#14
21.05.2017 20:14:59
Цитата
откройте исходный файл, посмотрите а строку 506, она видна?
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
 
 
#15
21.05.2017 20:24:40
Цитата
откройте исходный файл, посмотрите а строку 506, она видна?
У меня не видна, и не должна быть видна. Может, не тот файл прикрепил. Прикрепляю еще раз...
Ваш последний макрос скрывает все пустые строки в диапазоне A6:F505, а начиная с 506-й строки наоборот открывает...
Еще раз попробую объяснить:
Есть 500 строк (A6:F505). Нужно, чтобы в этом диапазоне они были открыты, а начиная с 506-й - скрыты.
 
 
 
#16
21.05.2017 20:55:04
Может циклом? Обрамление ячеек можно потом добавить на весь диапазон.
Код
Sub Macro1()
Dim LastRow As Long, i As Long, Rng As Range
    LastRow = Cells(Rows.Count, 1).End(xlUp).Row
    Set Rng = Range(Cells(LastRow + 1, 1), Cells(LastRow + 1, 6))
    For i = LastRow To 6 Step -1
        If Application.WorksheetFunction.CountBlank(Range(Cells(i, 1), Cells(i, 6))) > 0 Then
            Range(Cells(LastRow, 1), Cells(i + 1, 6)).Cut Cells(i, 1)
        End If
    Next
End Sub
 
 
 
#17
21.05.2017 21:02:19
Цитата
Может циклом? Обрамление ячеек можно потом добавить на весь диапазон.
Это в примере лишь обрамление, а в исходной таблице немного другая стилистика, там некоторые ячейки и цветами закрашены =)
Если так будет реально проще, я тогда скину пример с другим оформлением...
 
 
 
#18
22.05.2017 00:45:29
Юрий М
Прикрепил пример с нужным оформлением. Как и в тот раз, на листе 1 - исходные данные, на листе 2 - что должно получиться после выполнения макроса.
Изменено: flashertheone - 22.05.2017 00:45:51
 
 
 
#19
22.05.2017 08:47:29
Цитата
flashertheone написал: там некоторые ячейки и цветами закрашены =)
а цвет - это не оформление?  :)
попробуйте добавить к коду #16 от Юрий М - Autofill (можно прямо из Справки F1 со своими диапазонами)
Код
Sub Macro1()
Dim LastRow As Long, i As Long, Rng As Range
    LastRow = Cells(Rows.Count, 1).End(xlUp).Row
    Set Rng = Range(Cells(LastRow + 1, 1), Cells(LastRow + 1, 6))
    For i = LastRow To 6 Step -1
        If Application.WorksheetFunction.CountBlank(Range(Cells(i, 1), Cells(i, 6))) > 0 Then
            Range(Cells(LastRow, 1), Cells(i + 1, 6)).Cut Cells(i, 1)
            cnt = cnt + 1
        End If
    Next
    
    LastRow = Cells(Rows.Count, 1).End(xlUp).Row
    Set SourceRange = Range(Cells(LastRow, 1), Cells(LastRow, 6))
    Set fillRange = Range(Cells(LastRow, 1), Cells(LastRow + cnt, 6))
    SourceRange.AutoFill Destination:=fillRange, Type:=xlFillFormats
End Sub
Изменено: JeyCi - 22.05.2017 08:48:02
чтобы не гадать на кофейной гуще, кто вам отвечает и после этого не совершать кучу ошибок - обратитесь к собеседнику на ВЫ - ответ на ваш вопрос получите - а остальное вас не касается (п.п.п. на форумах)
 
 
 
#20
22.05.2017 12:45:32
JeyCi, спасибо, это работает, но я только сейчас заметил, что этот макрос не удаляет последнюю строку. Вот попробуйте в файле с примером удалить из последней заполненной строки (№10) значение из любой ячейки, а затем активировать макрос . Он не удалит эту строку =(
 
 
 
#21
22.05.2017 13:00:37
Я макрорекордером сам немного допилил макрос от Ігор Гончаренко из поста №4. Совсем уж дилетантский макрос получился или норм?) Работает, в принципе, как надо...
Код
Sub DelRowsWithBlankCell()
' Поиск и удаление пустых и частично заполненных строк, а также скрытие всех строк, начиная с 506-й
  Dim rg As Range:  On Error Resume Next
  With Range("A6:F505").SpecialCells(xlCellTypeBlanks).EntireRow
    If Err = 0 Then .ClearContents: .Copy Cells(506, 1): .Delete
  End With
  Rows("506:506").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.EntireRow.Hidden = True
    Range("A6").Select
End Sub
 
 
 
#22
22.05.2017 13:20:21
SELECT И ACTIVATE - ЗАЧЕМ НУЖНЫ И НУЖНЫ ЛИ?

Формула массива (ФМ) вводится Ctrl+Shift+Enter
Memento mori
 
 
 
#23
22.05.2017 14:42:12
JayBhagavan, прочитал, буду стараться внедрять)

В общем, оказалось, что макрос от Ігор Гончаренко работает не совсем верно. При применении его в исходном файле получилась следующая ситуация:
Исходный файл состоит не только из одного этого листа, а из нескольких. Данные вводятся на лист2 в диапазон A6:F505, как я показал в примере. А на остальных листах в ячейках возвращаются данные, в зависимости от определенного условия через функции ИНДЕКС и ПОИСКПОЗ. То есть, на остальных листах стоят ссылки на этот диапазон. И при применении макроса от Ігор Гончаренко, ссылки портятся и приобретают вид не $A$6:$F$505, а #ССЫЛКА, соответственно остальные листы теряют свою функциональность...
При применении макроса от Юрий М такой проблемы нет, но этот макрос не работает на последнюю заполненную строку диапазона. То есть, например, мы скопировали данные на первые 6 строк, из любой ячейки 6-ой строки мы удаляем значение, применяем макрос и он эту строку оставляет (а должен очищать). Поэтому попрошу добрых людей допилить вот этот макрос таким образом, чтобы он работал и на последнюю строку тоже.

Код
Sub Macro1()
Dim LastRow As Long, i As Long, Rng As Range
    LastRow = Cells(Rows.Count, 1).End(xlUp).Row
    Set Rng = Range(Cells(LastRow + 1, 1), Cells(LastRow + 1, 6))
    For i = LastRow To 6 Step -1
        If Application.WorksheetFunction.CountBlank(Range(Cells(i, 1), Cells(i, 6))) > 0 Then
            Range(Cells(LastRow, 1), Cells(i + 1, 6)).Cut Cells(i, 1)
            cnt = cnt + 1
        End If
    Next
     
    LastRow = Cells(Rows.Count, 1).End(xlUp).Row
    Set SourceRange = Range(Cells(LastRow, 1), Cells(LastRow, 6))
    Set fillRange = Range(Cells(LastRow, 1), Cells(LastRow + cnt, 6))
    SourceRange.AutoFill Destination:=fillRange, Type:=xlFillFormats
End Sub


P.S. надо было в примере какие-нибудь связи между листами изобразить, а то подумал, что это не так уж важно, а оказалось в итоге, что сам запутался и других запутал)
 
 
 
#24
22.05.2017 19:42:17
Или этот попробовать макрос доработать...

Код
Sub DelRowsWithBlankCell()
  Dim rg As Range:  On Error Resume Next
  With Range("A6:F505").SpecialCells(xlCellTypeBlanks).EntireRow
    If Err = 0 Then .ClearContents: .Copy Cells(506, 1): .Delete
  End With
End Sub


.Delete тут не подходит. Можно, например оставить этот кусок кода

Код
Sub DelRowsWithBlankCell()
  Dim rg As Range:  On Error Resume Next
  With Range("A6:F505").SpecialCells(xlCellTypeBlanks).EntireRow
    If Err = 0 Then .ClearContents
  End With
End Sub


Этот макрос будет очищать строки, если хотя бы одна из ячеек строки в указанном диапазоне пустая. Это то, что надо. Но как сделать так, чтобы пустых строк НЕ БЫЛО между заполненными строками? Без .Delete. Приложу скриншоты для "понятности", а то слов много, а на примере очень легко осознать, какого именно результата нужно добиться)
Ребят, выручайте, третий день не могу результата добиться...
Изменено: flashertheone - 22.05.2017 19:44:06
 
 
 
Страницы: 1
Наверх