PDA

Показать полную графическую версию : Сбор данных с определенного листа большого кол-ва книг на один лист


blackeangel
24-04-2018, 23:03
Всем доброго времени суток.
Недолго думая я погуглил, нашел как листы скопировать со всех книг в одну. Погуглил ещё нашел как всю информацию записать на 1 лист. Подкорректировал, сделал, чтоб сразу как надо было, но увы, меня ждала неудача. Теряется 1 строка при копировании информации с последующей книги. Код у меня такой

Sub CombineWorkbooks()
Dim FilesToOpen
Dim x As Integer
On Error GoTo ErrHandler
Application.ScreenUpdating = False
FilesToOpen = Application.GetOpenFilename _
(FileFilter:="Microsoft Excel Files (*.xls), *.xls", _
MultiSelect:=True, Title:="Files to Merge")
If TypeName(FilesToOpen) = "Boolean" Then
MsgBox "Не выбрано ни одного файла!"
GoTo ExitHandler
End If
x = 1
While x <= UBound(FilesToOpen)
Workbooks.Open Filename:=FilesToOpen(x)
Sheets(3).Range("A1:Z" & Sheets(3).UsedRange.Rows.Count + 1).Copy ThisWorkbook.Sheets(1).Range("A" & ThisWorkbook.Sheets(1).UsedRange.Rows.Count + 1)
x = x + 1
Wend
ExitHandler:
Application.ScreenUpdating = True
Exit Sub
ErrHandler:
MsgBox Err.Description
Resume ExitHandler
End Sub

Где я напортачил?

Iska
24-04-2018, 23:42
Где я напортачил? »
Не приложили примеры Рабочих книг, упакованных в архив ;). Не пришлось бы гадать, какая именно строка:
Теряется 1 строка при копировании информации с последующей книги. »
теряется.

как листы скопировать со всех книг в одну. »
А нужно ли?

Что я бы наверняка поменял:
Workbooks.Open Filename:=FilesToOpen(x)
Sheets(3).Range("A1:Z" & Sheets(3).UsedRange.Rows.Count + 1).Copy ThisWorkbook.Sheets(1).Range("A" & ThisWorkbook.Sheets(1).UsedRange.Rows.Count + 1)

Надо не просто открывать Рабочую книгу «в никуда» и играться далее в игры с неявной ссылкой ActiveWorkbook, а, открывая Рабочую книгу, сразу получать ссылку на неё и работать далее с этой открытой Рабочей книгой только через неё:
Dim objWorkbook As Workbook

Set objWorkbook = Workbooks.Open(Filename:=FilesToOpen(x))
objWorkbook.Sheets(3).Range("A1:Z" & objWorkbook.Sheets(3).UsedRange.Rows.Count + 1).Copy …

objWorkbook.Close

Строка теряться может где угодно, надо смотреть в содержимое реальных Рабочих книг. Например, пустая (пусть даже скрытая) строка вверху Рабочей книги — и .Range("A1:Z" & .UsedRange.Rows.Count + 1) захватит на строку меньше, нежели ожидалось. Две-три-четыре таких пустых строки дадут столько же потерянных. Я, кстати, не понял, зачем Вам там к .Rows.Count ещё и +1.

В общем, крайне желательны образцы.

blackeangel
25-04-2018, 06:52
Iska, примерчики приложу чуть позже.
Да, копировать именно надо в один лист. Задача на самом деле куда шире: надо из выбранных файлов сгруппировать по дате создания, содержимое третьего листа всех сгруппированных файлов(группировка по месяцам) прочитать на временный лист, удалить дубли,проставить в свободный столбец месяц и год. На новый лист подвести итог - кол-во записей с предыдущего листа по месяцам.

На счёт того кто косячит: косячит именно та строка что вы усомнились. Не происходит сдвиг курсора на строку ниже, а запись начинает сразу в последнюю строку. Добавляя +1 я пытался исправить это положение, но безуспешно.
Если это всё хозяйство разбить на 2 этапа: в книгу собираем нужные листы из других книг, а потом пробегаясь по листам собирать данные на один лист - то всё работает правильно. А вот сразу на лету - нет.
Для уточнения-теряется последняя строка предыдущего копирования.
Всё описал как то сумбурно, но как смог.

Iska
25-04-2018, 14:01
blackeangel, ну, вот, как раз потому я и прошу образцы Рабочих книг, дабы было на чём «щупать» код.

blackeangel
25-04-2018, 14:10
Iska, вот и файлики. Только пришлось подрезать их до 1 листа.

Iska
25-04-2018, 15:19
Только пришлось подрезать их до 1 листа. »
Зачем?

Sheets(3).Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
Э… Теперь Вы собираете рабочие листы в одной Рабочей книге?

вот и файлики. »
Сборка может быть осуществлена примерно таким кодом:
Option Explicit

Sub CombineWorkbooks()
Dim arrSelectedWorkbooks As Variant
Dim strWorkbook As Variant

arrSelectedWorkbooks = Application.GetOpenFilename( _
FileFilter:="Microsoft Excel Files (*.xlsx), *.xlsx", _
Title:="Files to Merge", _
MultiSelect:=True _
)

If IsArray(arrSelectedWorkbooks) Then
For Each strWorkbook In arrSelectedWorkbooks
With Application.Workbooks.Open(Filename:=strWorkbook)
.Sheets.Item("Сборки для диспетчера").UsedRange.Copy ThisWorkbook.Sheets.Item(1).UsedRange.Offset(ThisWorkbook.Sheets.Item(1).UsedRange.Rows.Count)
.Close
End With
Next strWorkbook
Else
MsgBox "Не выбрано ни одного файла!"
End If
End Sub

При этом:
а) на рабочем листе сборки первая строка останется пустой (потому как и на пустом рабочем листе свойство .UsedRange пустым не бывает), в принципе, это можно учесть, я просто не стал усложнять здесь код;
б) сборка происходит с заголовками «№ сборки», это тоже можно учесть и исключить.

blackeangel
25-04-2018, 16:30
Теперь Вы собираете рабочие листы в одной Рабочей книге?

Я ж писал, что только так работает правильно, а не сразу "на лету"

Iska
25-04-2018, 17:14
Я ж писал, что только так работает правильно, а не сразу "на лету" »
Выложенный мною код на выложенных Вами файлах работает «на лету». Смотрите, пробуйте, уточняйте, задавайте вопросы.

blackeangel
25-04-2018, 17:21
Iska, разобрался. Да, действительно на лету.
Как бы это переделать теперь чтоб предлогалось выбрать листы(номер или имя), а если не указаны, то всю книгу целиком. Но запрос только один раз был, а не по каждой книге) да, и отвязаться от thisworkbook как? Чтоб было что то типа activeworkbook. Но при открытии ведь activeworkbook меняется на вновь открытый файл. В общем почти что модуль надстройки)

Iska
25-04-2018, 17:59
Как бы это переделать теперь чтоб предлогалось выбрать листы(номер или имя), а если не указаны, то всю книгу целиком. »
Например? И зачем? И — листы или один лист? Вот в выложенных Вами образцах по одному Рабочему листу, и каждый из них имеет одно и то же имя. А как с этим обстоят дела в настоящих, оригинальных Рабочих книгах?

Но запрос только один раз был, а не по каждой книге) »
Не понял. Поясните.

да, и отвязаться от thisworkbook как? Чтоб было что то типа activeworkbook. Но при открытии ведь activeworkbook меняется на вновь открытый файл. »
Чтобы использовать в качестве целевой уже открытую текущую Рабочую книгу? Объявляете Dim objSomeWorkbook As Workbook в начале кода, далее делаете присвоение Set objSomeWorkbook = ActiveWorkbook, далее пользуете objSomeWorkbook.

blackeangel
25-04-2018, 22:40
Iska,

Не понял. Поясните.

Ну типа диалога вылазит с возможностью ввода либо имени листа, либо номера листа. Это читается в переменную потом дальше подставляется. Если ничего не введено ="", то тогда копирует все листы в текущую книгу, и объединяя листы с одинаковыми названиями.

Например? И зачем? И — листы или один лист?

И один лист и несколько листов.
Зачем? Ну например, мне надо данные собрать с 30 книг с 5 и 7 листов. Причём тут так же 2 варианта либо все сваливать в одну кучу с обоих листов, либо же каждый лист складировать по отдельности.
Вариантов много.
Просто хочу в свою надстройку вставить, а то случаи разные бывают. А код запросто потеряется и забудется, а надстройка - никогда)

Задача на самом деле куда шире: надо из выбранных файлов сгруппировать по дате создания

Это то хоть реально реализовать?

Iska
26-04-2018, 02:04
Ну типа диалога вылазит с возможностью ввода либо имени листа, либо номера листа. »
Ясно. Создаёте UserForm, добавляете в него ListBox со множественным выделением, при инициализации формы из кода программно заполняете этот ListBox именами листов указанной Рабочей книги. В принципе можно и всё делать программно, включая создание-рисование формы и элементов диалога на ней.

Я бы мог приложить Вам пример, но у меня Office 2003, в новых Office, насколько я помню, концепция поменялась, и MSForm 2.0 не используется.

Это то хоть реально реализовать? »
Поясните. Я опять не понял. Что группировать? Чья дата создания?

blackeangel
26-04-2018, 04:47
Iska,

Что группировать? Чья дата создания?

Группировать выбранные файлы в списке. Дата создания файлов

Iska
26-04-2018, 04:52
Группировать выбранные файлы в списке. Дата создания файлов »
blackeangel, всё равно не понятно. Можно на каком-либо примере с картинками пояснить?

blackeangel
27-04-2018, 22:06
Iska, а что здесь непонятного? Есть n файлов папке, из них надо выбрать все файлы за март, потом из этого же n выбрать за февраль и так по всем месяцам. Получим на выходе 12 одномерных массивов с путями файлов.
Но единственное, что надо лезть в свойства файлов и смотреть дату создания, а не дату открытия или изменения.

Iska
27-04-2018, 22:30
Iska, а что здесь непонятного? Есть n файлов папке, из них надо выбрать все файлы за март, потом из этого же n выбрать за февраль и так по всем месяцам. Получим на выходе 12 одномерных массивов с путями файлов. »
Ага… Ну, так в чём проблема-то? Выбрали файлы в Application.GetOpenFilename(), дальше посредством Scripting.FileSystemObject смотрим их свойство .DateCreated, функцией Month() определяем месяц (что при этом делать с годом — непонятно). Дальше — зависит от того, какой конечный вид Вы хотите получить в итоге. Необходимости в массивах пока не вижу.




© OSzone.net 2001-2012