Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
VBA копирование диапазона с удалением пустых строк
 
#1
23.05.2018 22:53:22
Добрый вечер уважаемые профи, просьба помочь в решении следующей проблемы:
Есть очень длинная таблица более 30000 тысяч строк после кучи формул программа отсеивает ненужные строки в определенный диапазон (в примере выделено синим) -это то с чем нужно работать. После отсеивания с помощью макро-рекодера был сделан макрос, который копирует "синий диапазон" на новый лист (в примере (лист 2)), после этого прочитав кучу тем на планете) подобрали следующие макросы:
После копирования значений на лист два нажимаются следующие макросы в строгом порядке:
1) Макрос удаляющий строки нулевого значения со всего листа (не знаю как задать renge под этот макрос) (так как после копирования значений строки в которых на листе 1 были формулы на листе 2 остаются не пустые строки но с виду они пустые).
2) Макрос выделяющий пустые строки ( к сожалению без renge).
3) Макрос удаляющий пустые строки ( к сожалению без renge).
4) Макрос  копирующий полученный результат на новый лист для дальнейшей работы.
-Так вот уважаемые специалисты VBA можно ли как нибудь упростить данный цикл макросов? Наверняка есть какой то способ!!!
Проблема усложняется тем, что в рабочей таблице ооочень много формул и макросов помимо этого цикла, и почему то макрос копи/паст (которых 8 штук) в основной таблице работает через раз (появляется ошибка 400) думаю из за большого количества макросов и формул. Да и за диапазон было взято 50000 но строк может быть больше или меньше, можно ли как то добавить в макрос авто определения range???

вопрос не по теме удален [МОДЕРАТОР]
ПС Я пока только учусь VBA к сожалению я только в начале пути! Всем спасибо за внимание!!!
 
 
 
 
#2
23.05.2018 23:42:20
Для синей таблицы:
Пустая строка = Пустой ID
Пройдитесь по ней циклом, определив последний непустой ID как Selection.End(xlDown).Select, и если ID пустой - выделяйте и удаляйте строку

Цитата
(так как после копирования значений строки в которых на листе 1 были формулы на листе 2 остаются не пустые строки но с виду они пустые).
Здесь это вам даже поможет
 
 
 
#3
23.05.2018 23:58:31
Не совсем понял, но делаю так при удалении ненужных пустых строк
Отключаются автовычисления,
1. В доп столбец объединяются нужные значения.(если надо - добавляется индекс строки: 1, 2,3 с условием. если результат объединения не пустой)
пишем в макросе  calculate, если не макросом делали объединение. а через формулы
2. Выделяется  весь диапазон с шапкой.
3. Используем встроенный инструмент "Удалить дубликаты" по столбцу где объединены нужные данные
5. Удаляем нулевую строку, оставшуюся после этого действа
Включаем автовычисления
Изменено: Sobes - 24.05.2018 00:01:18
 
 
 
#4
24.05.2018 00:06:48
выполните этот макрос
Код
Sub CopyGJ()
  Dim ar: ar = Range("G:J").Value
  Worksheets.Add after:=Worksheets(Worksheets.Count)
  Range("A:D").Value = ar
  Columns(3).SpecialCells(4).EntireRow.Delete
End Sub
при активном листе 1 (с синей таблицей)
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
 
 
#5
24.05.2018 11:10:24
Игорь огромное спасибо! То что нужно, немного изменили Ваш макрос под себя:
Код
Sub CopyGJ()
Sheets("1").Select
  Dim ar: ar = Range("G:J").Value
  Sheets("3").Select
  Range("A:D").Value = ar
  Columns(3).SpecialCells(4).EntireRow.Delete
End Sub
Но возник вопрос, как то можно запускать этот макрос в фоне (этот лист будет скрыт от сотрудников) на данный момент при отработке макроса эксель на  несколько секунд переходит на первоначальный лист для копирования информации - этого быть не должно!(  
 
 
 
#6
24.05.2018 11:29:10
Перед обращением к листам
Код
Application.ScreenUpdating = False

В конце обработки включить
 
 
 
#7
24.05.2018 11:33:56
Будет при любом активном листе
И старайтесь избегать Select, т.к. это не быстрая операция...
Код
Sub CopyGJ()
Dim ar()
ar = Sheets("1").Range("G:J").Value
Sheets("3").Range("A:D").Value = ar
Sheets("3").Columns(3).SpecialCells(4).EntireRow.Delete
End Sub

Можно еще проще:
Код
Sub CopyGJ()
Application.ScreenUpdating = False
Sheets("3").Range("A:D").Value =  Sheets("1").Range("G:J").Value
Sheets("3").Columns(3).SpecialCells(4).EntireRow.Delete
Application.ScreenUpdating = True
End Sub
Изменено: AAF - 24.05.2018 11:41:20
 
 
 
#8
24.05.2018 11:49:30
AAF спасибо! Ваш второй макрос к сожалению не работает ошибка range, первый работает отлично! СПАСИБО!!!!
 
 
 
#9
24.05.2018 12:57:24
WanderKat, а можно прислать файл, в котором макрос не работает?
 
 
 
Страницы: 1
Наверх