Компьютерный форум OSzone.net  

Компьютерный форум OSzone.net (http://forum.oszone.net/index.php)
-   Программирование и базы данных (http://forum.oszone.net/forumdisplay.php?f=21)
-   -   Сбор данных с определенного листа большого кол-ва книг на один лист (http://forum.oszone.net/showthread.php?t=334488)

blackeangel 24-04-2018 23:03 2810540
Сбор данных с определенного листа большого кол-ва книг на один лист
 
Всем доброго времени суток.
Недолго думая я погуглил, нашел как листы скопировать со всех книг в одну. Погуглил ещё нашел как всю информацию записать на 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 2810548
Цитата:
Цитата blackeangel
Где я напортачил? »
Не приложили примеры Рабочих книг, упакованных в архив ;). Не пришлось бы гадать, какая именно строка:
Цитата:
Цитата blackeangel
Теряется 1 строка при копировании информации с последующей книги. »
теряется.

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

Что я бы наверняка поменял:
Код:
        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 2810565
Iska, примерчики приложу чуть позже.
Да, копировать именно надо в один лист. Задача на самом деле куда шире: надо из выбранных файлов сгруппировать по дате создания, содержимое третьего листа всех сгруппированных файлов(группировка по месяцам) прочитать на временный лист, удалить дубли,проставить в свободный столбец месяц и год. На новый лист подвести итог - кол-во записей с предыдущего листа по месяцам.

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

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

blackeangel 25-04-2018 14:10 2810648
Вложений: 1
  • 03.18.rar (91.00 KB, скачиваний: 11)
Iska, вот и файлики. Только пришлось подрезать их до 1 листа.

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

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

Цитата:
Цитата blackeangel
вот и файлики. »
Сборка может быть осуществлена примерно таким кодом:
Код:
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 2810701
Цитата:
Теперь Вы собираете рабочие листы в одной Рабочей книге?
Я ж писал, что только так работает правильно, а не сразу "на лету"

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

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

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

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

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

blackeangel 25-04-2018 22:40 2810772
Iska,
Цитата:
Не понял. Поясните.
Ну типа диалога вылазит с возможностью ввода либо имени листа, либо номера листа. Это читается в переменную потом дальше подставляется. Если ничего не введено ="", то тогда копирует все листы в текущую книгу, и объединяя листы с одинаковыми названиями.
Цитата:
Например? И зачем? И — листы или один лист?
И один лист и несколько листов.
Зачем? Ну например, мне надо данные собрать с 30 книг с 5 и 7 листов. Причём тут так же 2 варианта либо все сваливать в одну кучу с обоих листов, либо же каждый лист складировать по отдельности.
Вариантов много.
Просто хочу в свою надстройку вставить, а то случаи разные бывают. А код запросто потеряется и забудется, а надстройка - никогда)
Цитата:
Задача на самом деле куда шире: надо из выбранных файлов сгруппировать по дате создания
Это то хоть реально реализовать?

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

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

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

blackeangel 26-04-2018 04:47 2810791
Iska,
Цитата:
Что группировать? Чья дата создания?
Группировать выбранные файлы в списке. Дата создания файлов

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

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

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


Время: 23:04.

Время: 23:04.
© OSzone.net 2001-