Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Microsoft Office и VBA программирование > Microsoft Office Excel
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 22.05.2017, 21:51   #1
flashrtheone
 
Регистрация: 12.06.2016
Сообщений: 4
По умолчанию Макрос для очищения строк по критерию

Добрый вечер!

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

Мне посоветовали вот этот код, но в таком виде он именно удаляет строки и на других листах формулы перестают работать.

Код:
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
Можно попробовать оставить этот кусок и доработать его:

Код:
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.

Для большей наглядности прикрепляю пример - на листе1 - пример исходных данных, на листе2 - пример того, как должен работать макрос.
Надеюсь, кто-нибудь поможет, а то уже 3-й день безрезультатно =(
Вложения
Тип файла: xlsx Primer.xlsx (29.9 Кб, 25 просмотров)
flashrtheone вне форума Ответить с цитированием
Старый 22.05.2017, 23:34   #2
IgorGO
Новичок
СтарожилДжуниор
 
Аватар для IgorGO
 
Регистрация: 05.02.2008
Сообщений: 9,487
По умолчанию

задача не решилась на "Планете"?
нужно просто не намеками, а прямым текстом говорить о том, что должно происходить с данными. ну будет код не в 6 строк, а в 12, зато будет точно выполнять поставленную задачу.
понимаете, потому что рассказ, что нужно удалить строку, но так чтобы ее не удалять... способен повергнуть в сильные раздумия каждого, чей мозг оборудован хоть каким-то задатками логики
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете
IgorGO вне форума Ответить с цитированием
Старый 23.05.2017, 02:17   #3
flashrtheone
 
Регистрация: 12.06.2016
Сообщений: 4
По умолчанию

Цитата:
Сообщение от IgorGO Посмотреть сообщение
задача не решилась на "Планете"?
Нет, не решилась.

Цитата:
Сообщение от IgorGO Посмотреть сообщение
рассказ, что нужно удалить строку, но так чтобы ее не удалять...
Такого я точно не говорил)
Вот моя цитата - "если в строке A6:F6 есть хотя бы одна пустая ячейка, то должна очищаться вся строка (имею в виду не удаление строки, а удаление данных из всех ячеек этой строки)"

Да, я не смог сразу учесть все нюансы при описании задачи. Когда я начал применять предлагаемые макросы, я понял, что еще много чего не учел... Поэтому и пишу очень много слов, хотя ожидаемый результат должен быть понятен при беглом взгляде на пример...
flashrtheone вне форума Ответить с цитированием
Старый 23.05.2017, 07:59   #4
SAS888
Старожил
 
Аватар для SAS888
 
Регистрация: 05.12.2007
Сообщений: 4,180
По умолчанию

Если я правильно понял, то Вам требуется удалить все пустые строки в таблице, но таким образом, чтобы не "поехала" нижняя граница таблицы. Так?
Если так, то для Вашего примера (таблица в диапазоне "A6:F11") можно использовать код:
Код:
Sub ClearTab()
    Dim i As Long, j As Long, k As Long, x As Range, a(), b()
    Set x = [A6:F11]: Application.ScreenUpdating = False
    If Application.CountA(x) = x.Count Then Exit Sub
    x.SpecialCells(4).EntireRow.ClearContents
    a = x.Value: ReDim b(1 To UBound(a, 1), 1 To UBound(a, 2))
    For i = 1 To UBound(a, 1)
        If a(i, 1) <> "" Then
            j = j + 1
            For k = 1 To UBound(b, 2): b(j, k) = a(i, k): Next
        End If
    Next: x.Value = b
End Sub
Чем шире угол зрения, тем он тупее.
SAS888 вне форума Ответить с цитированием
Старый 23.05.2017, 12:09   #5
flashrtheone
 
Регистрация: 12.06.2016
Сообщений: 4
По умолчанию

SAS888, огромное спасибо, наконец все работает как надо!)
Один вопрос: мне нужно для диапазона A6:F505, значит мне нужно поменять в третьей строке:
Код:
Set x = [A6:F11]
на
Код:
Set x = [A6:F505]
Правильно я понял? Больше нигде ничего не нужно?
flashrtheone вне форума Ответить с цитированием
Старый 23.05.2017, 13:40   #6
IgorGO
Новичок
СтарожилДжуниор
 
Аватар для IgorGO
 
Регистрация: 05.02.2008
Сообщений: 9,487
По умолчанию

ничего больше не нужно
форматирование ВСЕХ ячеек останется на месте
данные подымутся вверх, заполняя строки где была хоть 1 пустая ячейка
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете
IgorGO вне форума Ответить с цитированием
Старый 24.05.2017, 19:54   #7
flashrtheone
 
Регистрация: 12.06.2016
Сообщений: 4
По умолчанию

Огромное спасибо, выручили!
flashrtheone вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
макрос для удаления строк??? mixa2997510 Microsoft Office Excel 3 21.05.2012 13:38
Прога для очищения свойств файлов Ghost3 Софт 5 19.10.2011 19:32
макрос для нумерации строк Olya1985 Microsoft Office Excel 5 07.01.2011 23:46
Удаление строк по определенному критерию Franck Microsoft Office Excel 4 16.02.2009 11:27