собрать книги в одну, распределив строки на 2 листа по усло

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Мир MS Excel » Вопросы и решения » Вопросы по VBA » собрать книги в одну, распределив строки на 2 листа по усло (Макросы Sub)

SergeyKorotun

Дата: Пятница, 31.01.2014, 22:50 | Сообщение № 1

Группа: Проверенные

Ранг: Обитатель

Сообщений: 301

Репутация: 15 ±

Замечаний: 0% ±

Excel 2007

Есть много книг с одинаковой структурой с большим количеством строк и столбцов. Надо их собрать в одну, распределив строки на два листа по условию: если dk=0, то на первый лист, а если dk=1, то на второй лист. Больше никаких значений dk не принимает. В прилагаемом файле пример одной книги. Какой метод отбора строк будет выполняться быстрее: устанавливать фильтр два раза на dk? считать лист в массив и построчно разбрасывать по листам в зависимости от значения dk? скопировать один и тот же лист в два массива и в одном удалить значения с dk=1, а во втором с dk=0 и добавить полученные массивы в соответствующие листы? отсортировать лист по dk, а потом пока dk=0 добавлять строки на 1 лист, а потом пока строки не окончатся во второй лист? ...?

К сообщению приложен файл: qwerty.xlsx (8.9 Kb)

Ответить

KuklP

Дата: Суббота, 01.02.2014, 05:49 | Сообщение № 2

Группа: Проверенные

Ранг: Старожил

Сообщений: 2369

Репутация: 486 ±

Замечаний: 0% ±

2003-2010

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

Ну с НДС и мы чего-то стoим! kuklp60@gmail.com
WM Z206653985942, R334086032478, U238399322728

Ответить

SergeyKorotun

Дата: Воскресенье, 02.02.2014, 20:29 | Сообщение № 3

Группа: Проверенные

Ранг: Обитатель

Сообщений: 301

Репутация: 15 ±

Замечаний: 0% ±

Excel 2007

[vba]

Код

     Workbooks(nameFile).Sheets(nameFileNoExt).Activate 'лист в отрытой макросом книге делаю активным
     ThisWorkbook.Sheets("ESV_all").Cells(Rows.Count, 1).End(xlUp).Select 'выделяю последнюю заполненную ячейку в первом столбце на листе ESV_all
     ThisWorkbook.Sheets("ESV_krd").Cells(Rows.Count, 1).End(xlUp).Select 'выделяю последнюю заполненную ячейку в первом столбце на листе ESV_krd
     ThisWorkbook.Sheets("ESV_dbt").Cells(Rows.Count, 1).End(xlUp).Select 'выделяю последнюю заполненную ячейку в первом столбце на листе ESV_dbt
     irow = Cells(Rows.Count, 1).End(xlUp).Row 'кол-во строк в активной книге
     For i = 2 To irow
         If Cells(i, 8) = "" Then 'если в 8 столбике в текущей строки пусто, прекратить обрабатывать активную книгу
            Exit For
         End If
         If Cells(i, 8) = 0 Then 'если в 8 столбике в текущей строки 0, то ее нужно скопировать на лист ESV_dbt книги, из которой запускался макрос
            NameSheet = "ESV_dbt"
         End If
         If Cells(i, 8) = 1 Then 'если в 8 столбике в текущей строки 1, то ее нужно скопировать на лист ESV_dbt книги, из которой запускался макрос
            NameSheet = "ESV_krd"
         End If
         ActiveWorkbook.Sheets(nameFileNoExt).Rows(i).Copy ThisWorkbook.Sheets(NameSheet).ActiveCell.Offset(1, 0) 'копирование на лист ESV_dbt или ESV_krd, сместившись предварительно на пустую строку
         ActiveWorkbook.Sheets(nameFileNoExt).Rows(i).Copy ThisWorkbook.Sheets("ESV_all").ActiveCell.Offset(1, 0) 'копирование всех записей на лист ESV_all
     Next i

[/vba]
Где ошибка в этих строках:
ActiveWorkbook.Sheets(nameFileNoExt).Rows(i).Copy ThisWorkbook.Sheets(NameSheet).ActiveCell.Offset(1, 0)
ActiveWorkbook.Sheets(nameFileNoExt).Rows(i).Copy ThisWorkbook.Sheets("ESV_all").ActiveCell.Offset(1, 0)
Ни одна строка не копируется.

[vba]

Код

Ответить

Сообщение[vba]

Код

Автор - SergeyKorotun
Дата добавления - 02.02.2014 в 20:29

Hugo

Дата: Воскресенье, 02.02.2014, 20:52 | Сообщение № 4

Группа: Друзья

Ранг: Участник клуба

Сообщений: 3253

Репутация: 707 ±

Замечаний: 0% ±

2019

Судя по всему - ActiveCell может быть только на активном листе. Сам удивился - никогда не работаю так с ячейками...
Вот попробуйте код:
[vba]

Код

Sub tt()
      MsgBox ActiveCell.Address
      ThisWorkbook.Sheets(2).Activate
      MsgBox ThisWorkbook.Sheets(2).ActiveCell.Address
End Sub

[/vba]

excel@nxt.ru
webmoney: E265281470651 Z422237915069

Ответить

SergeyKorotun

Дата: Воскресенье, 02.02.2014, 21:17 | Сообщение № 5

Группа: Проверенные

Ранг: Обитатель

Сообщений: 301

Репутация: 15 ±

Замечаний: 0% ±

Excel 2007

закоментировал 2,3,4 строки, а те две что с ошибкой, заменил на:
[vba]

Код

ActiveWorkbook.Sheets(nameFileNoExt).Rows(i).Copy ThisWorkbook.Sheets(NameSheet).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
ActiveWorkbook.Sheets(nameFileNoExt).Rows(i).Copy ThisWorkbook.Sheets("ESV_all").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)

[/vba]
Заработало и код стал короче, но время выполнения увеличится по сравнению с нерабочим алгоритмом, в случае если бы он был рабочим. В нем нужно было шагнуть на одну ячейку вниз, а в этом скачет с миллионной ячейки в начало таблицы.

Сообщение отредактировал SergeyKorotun - Воскресенье, 02.02.2014, 21:17

Ответить

Hugo

Дата: Воскресенье, 02.02.2014, 21:25 | Сообщение № 6

Группа: Друзья

Ранг: Участник клуба

Сообщений: 3253

Репутация: 707 ±

Замечаний: 0% ±

2019

Запоминайте эти значения строк в переменные - их увеличивайте и копируйте. И не нужно будет определять.
Ну а активация только тормозит процесс.
И кстати такое определение ерунда по сравнению с временем открытия книги.
Можно в цикле поопределять ячейки и замерить - сколько займёт времени например 1000 определений.

excel@nxt.ru
webmoney: E265281470651 Z422237915069

Ответить

Serge_007

Дата: Понедельник, 03.02.2014, 02:00 | Сообщение № 7

Группа: Админы

Ранг: Местный житель

Сообщений: 16475

Репутация: 2749 ±

Замечаний: ±

Excel 2016

Цитата Hugo, 02.02.2014 в 20:52, в сообщении № 4

ActiveCell может быть только на активном листе.

http://www.excelworld.ru/forum/10-4879-1#50453

ЮMoney:41001419691823 | WMR:126292472390

Ответить

Страница 1 из 1
1