Показать полную графическую версию : Сбор данных с определенного листа большого кол-ва книг на один лист
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
Где я напортачил?
Где я напортачил? »
Не приложили примеры Рабочих книг, упакованных в архив ;). Не пришлось бы гадать, какая именно строка:
Теряется 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 этапа: в книгу собираем нужные листы из других книг, а потом пробегаясь по листам собирать данные на один лист - то всё работает правильно. А вот сразу на лету - нет.
Для уточнения-теряется последняя строка предыдущего копирования.
Всё описал как то сумбурно, но как смог.
blackeangel, ну, вот, как раз потому я и прошу образцы Рабочих книг, дабы было на чём «щупать» код.
blackeangel
25-04-2018, 14:10
Iska, вот и файлики. Только пришлось подрезать их до 1 листа.
Только пришлось подрезать их до 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
Теперь Вы собираете рабочие листы в одной Рабочей книге?
Я ж писал, что только так работает правильно, а не сразу "на лету"
Я ж писал, что только так работает правильно, а не сразу "на лету" »
Выложенный мною код на выложенных Вами файлах работает «на лету». Смотрите, пробуйте, уточняйте, задавайте вопросы.
blackeangel
25-04-2018, 17:21
Iska, разобрался. Да, действительно на лету.
Как бы это переделать теперь чтоб предлогалось выбрать листы(номер или имя), а если не указаны, то всю книгу целиком. Но запрос только один раз был, а не по каждой книге) да, и отвязаться от thisworkbook как? Чтоб было что то типа activeworkbook. Но при открытии ведь activeworkbook меняется на вновь открытый файл. В общем почти что модуль надстройки)
Как бы это переделать теперь чтоб предлогалось выбрать листы(номер или имя), а если не указаны, то всю книгу целиком. »
Например? И зачем? И — листы или один лист? Вот в выложенных Вами образцах по одному Рабочему листу, и каждый из них имеет одно и то же имя. А как с этим обстоят дела в настоящих, оригинальных Рабочих книгах?
Но запрос только один раз был, а не по каждой книге) »
Не понял. Поясните.
да, и отвязаться от thisworkbook как? Чтоб было что то типа activeworkbook. Но при открытии ведь activeworkbook меняется на вновь открытый файл. »
Чтобы использовать в качестве целевой уже открытую текущую Рабочую книгу? Объявляете Dim objSomeWorkbook As Workbook в начале кода, далее делаете присвоение Set objSomeWorkbook = ActiveWorkbook, далее пользуете objSomeWorkbook.
blackeangel
25-04-2018, 22:40
Iska,
Не понял. Поясните.
Ну типа диалога вылазит с возможностью ввода либо имени листа, либо номера листа. Это читается в переменную потом дальше подставляется. Если ничего не введено ="", то тогда копирует все листы в текущую книгу, и объединяя листы с одинаковыми названиями.
Например? И зачем? И — листы или один лист?
И один лист и несколько листов.
Зачем? Ну например, мне надо данные собрать с 30 книг с 5 и 7 листов. Причём тут так же 2 варианта либо все сваливать в одну кучу с обоих листов, либо же каждый лист складировать по отдельности.
Вариантов много.
Просто хочу в свою надстройку вставить, а то случаи разные бывают. А код запросто потеряется и забудется, а надстройка - никогда)
Задача на самом деле куда шире: надо из выбранных файлов сгруппировать по дате создания
Это то хоть реально реализовать?
Ну типа диалога вылазит с возможностью ввода либо имени листа, либо номера листа. »
Ясно. Создаёте UserForm, добавляете в него ListBox со множественным выделением, при инициализации формы из кода программно заполняете этот ListBox именами листов указанной Рабочей книги. В принципе можно и всё делать программно, включая создание-рисование формы и элементов диалога на ней.
Я бы мог приложить Вам пример, но у меня Office 2003, в новых Office, насколько я помню, концепция поменялась, и MSForm 2.0 не используется.
Это то хоть реально реализовать? »
Поясните. Я опять не понял. Что группировать? Чья дата создания?
blackeangel
26-04-2018, 04:47
Iska,
Что группировать? Чья дата создания?
Группировать выбранные файлы в списке. Дата создания файлов
Группировать выбранные файлы в списке. Дата создания файлов »
blackeangel, всё равно не понятно. Можно на каком-либо примере с картинками пояснить?
blackeangel
27-04-2018, 22:06
Iska, а что здесь непонятного? Есть n файлов папке, из них надо выбрать все файлы за март, потом из этого же n выбрать за февраль и так по всем месяцам. Получим на выходе 12 одномерных массивов с путями файлов.
Но единственное, что надо лезть в свойства файлов и смотреть дату создания, а не дату открытия или изменения.
Iska, а что здесь непонятного? Есть n файлов папке, из них надо выбрать все файлы за март, потом из этого же n выбрать за февраль и так по всем месяцам. Получим на выходе 12 одномерных массивов с путями файлов. »
Ага… Ну, так в чём проблема-то? Выбрали файлы в Application.GetOpenFilename(), дальше посредством Scripting.FileSystemObject смотрим их свойство .DateCreated, функцией Month() определяем месяц (что при этом делать с годом — непонятно). Дальше — зависит от того, какой конечный вид Вы хотите получить в итоге. Необходимости в массивах пока не вижу.
© OSzone.net 2001-2012
vBulletin v3.6.4, Copyright ©2000-2025, Jelsoft Enterprises Ltd.
Available in ZeroNet 1osznRoVratMCN3bFoFpR2pSV5c9z6sTC