Профессиональные приемы работы в Microsoft Excel

Пожалуйста, войдите или зарегистрируйтесь.


Расширенный поиск  

Новости:

Прикрепить к сообщению можно только файлы xls, gif, jpg, rar, zip,7z, bas, frm, cls, doc размером до 150 Кб.

Автор Тема: "Сборка" данных в новую книгу из файлов в папке без открытия исходных  (Прочитано 18887 раз)

0 Пользователей и 1 Гость просматривают эту тему.

Виктория Зуева

  • Постоялец
  • ***
  • Уважение: +21/-0
  • Оффлайн Оффлайн
  • Сообщений: 316
  • curious

Пример:
Есть две папки - "1квартал" и "2квартал" на диске D:\Отчеты2009.
Папки содержат файлы Excel - ежемесячные отчеты от отделов (в каждой папке около 70 штук). Имена файлов в папках одинаковые (Отдел 1.xls, Отдел 2.xls и т.д.) 
Файлы имеют похожую структуру - на 1-м (единственном) листе таблица, шапка таблицы у всех одинаковая (в 3-й строке), а вот строка итогов "прыгает" в зависимости от содержимого от 15 до 60 строки
( в D:\Отчеты2009\1квартал\Отдел 1.xls   итоговая строка - 25,
а в D:\Отчеты2009\2квартал\Отдел 1.xls   итоговая строка - 53).

В папке "1квартал" был создан файл Excel - Отчет 1квартал.xls , в который "ручками" были вставлены в ячейки строк  ссылки - на ячейки других книг папки "1квартал",  т.е. на соответствующие итоговые значения из файлов отчетов по отделам.
Например, ссылка в файле "Отчет 1квартал.xls" выглядит следующим образом (при закрытом файле Отдел 1.xls):
='D:\Отчеты2009\1квартал\[Отдел 1.xls]Лист1'!$D$25

Проблемы и вопросы:
Пока файл "Отчет 1квартал.xls" лежит в папке D:\Отчеты2009\1квартал\, все связи нормально работают. Если папка "1 квартал" со всем содержимым перемещается на другой диск, связи в  файле "Отчет 1квартал.xls" приходится отключать… иначе =#Н/Д.
1) Можно ли макросом определять текущее местонахождение отчетного файла на диске и менять в нем адреса ссылок на исходные файлы с тем же именем, но из текущей папки?
2) Что-бы придумать, чтоб для папки "2квартал" в файл "Отчет 2квартал.xls" итоговые данные по отделам "собирать" не ручками?

« Последнее редактирование: 06.07.2009, 00:39:21 от Виктория Зуева »
Записан

boa

  • Глобальный модератор
  • Старожил
  • *****
  • Уважение: +32/-0
  • Оффлайн Оффлайн
  • Сообщений: 594
  • Доброта спасет мир...

начну с конца :)
2) Что-бы придумать, чтоб для папки "2квартал" в файл "Отчет 2квартал.xls" итоговые данные по отделам "собирать" не ручками?

в итоговой строке в одной и той же колонке я бы написал одинаковый для всех файлов текст  типа "Общий итог"
тогда поиск номера итоговой стоки можно сделать так:
    Do: iRow = iRow + 1
    Loop Until Cells(iRow, [номер столбца]) = "Общий итог"

на выходе  iRow будет = номеру искомой строки
Записан
Ничто не обходится нам так дешево и не ценится так дорого, как вежливость...  Мигель Сервантес де Сааведра

Виктория Зуева

  • Постоялец
  • ***
  • Уважение: +21/-0
  • Оффлайн Оффлайн
  • Сообщений: 316
  • curious

Ячейка с текстом "Итого по отделу" присутствует во 2 столбце почти внизу каждого "Отчета". Ниже еще есть непустые строки. Я вот про ВПР думала по этому поводу.
А вот что делать с этим iRow? Его в модуль "отдела" или "отчета" прикручивать?  ???
Записан

boa

  • Глобальный модератор
  • Старожил
  • *****
  • Уважение: +32/-0
  • Оффлайн Оффлайн
  • Сообщений: 594
  • Доброта спасет мир...

это в модуль отчета для сбора инфы с разных файлов

Sub Reports()
Dim File  As Variant
Dim UserFile  As Variant
Dim iRow As Integer
Dim iRowRep As Integer
Dim i As Integer
Dim j As Integer


File = Array(file1, file2, file3, file4, file5, file6, file7, file8, file9, "и т.д.")
iRowRep = 5

    For i = LBound(File) To UBound(File)

        UserFile = File(i) & ".xls"
'можно сформировать имя файла и по другому
'    For i = 1 To [последний отдел]
'        UserFile = "Отдел " & i & ".xls"
'    Next i
 
        With Workbooks(UserFile).Sheets(1)
iRow = 0 'или следующая после "шапки"
            Do: iRow = iRow + 1
            Loop Until .Cells(iRow, 2) = "Итого по отделу"
       
           
            For j = 1 To [последний столбец]
                Cells(iRowRep, j) = .Cells(iRow, j)
            Next j
   
        End With
        iRowRep = iRowRep + 1
    Next i

End Sub


P.S. Если будут сложности,  - выложите файлы-образцы
« Последнее редактирование: 25.06.2009, 15:45:57 от boa »
Записан
Ничто не обходится нам так дешево и не ценится так дорого, как вежливость...  Мигель Сервантес де Сааведра

_Boroda_

  • Глобальный модератор
  • Ветеран
  • *****
  • Уважение: +415/-0
  • Оффлайн Оффлайн
  • Сообщений: 2 556

Я такие вещи делаю неизменяемым файлом без макросов, который после автозаполнения сохраняю в нужную папку.
Файл "Отчет" в папке "Отчеты2009". Он един для всех кварталов.
Порядок действий:
1) открыть все файлы в папке "nквартал" (n - номер квартала),
2) открыть файл "Отчет",
3) закрыть все файлы папки "nквартал".
В файле "Отчет" останутся все данные за квартал n.
Пункты 1 и 2 можно поменять местами.
Если случайно открыты файлы из разных папок (например 1квартал - отдел 1 и 2квартал - отдел 2), то в ячейке А1 - красная ругань, если все файлы из одной папки, то в А1 - № квартала.
Работает для 100 файлов, но можно увеличить.
ВПР в строке 5 нужно подогнать под родные файлы "отдел m" (вместо 2 поставить номер своего столбца с данными и изменить массив для поиска).
Записан
Скажи мне, кудесник, любимец ба’гов...



Яндекс-деньги: 41001632713405
Webmoney: R289877159277; Z102172301748; E177867141995

boa

  • Глобальный модератор
  • Старожил
  • *****
  • Уважение: +32/-0
  • Оффлайн Оффлайн
  • Сообщений: 594
  • Доброта спасет мир...

Виктория, посмотрите, это то?
Записан
Ничто не обходится нам так дешево и не ценится так дорого, как вежливость...  Мигель Сервантес де Сааведра

Виктория Зуева

  • Постоялец
  • ***
  • Уважение: +21/-0
  • Оффлайн Оффлайн
  • Сообщений: 316
  • curious

Boroda, спасибо за ваш пример - взяла себе в "копилку идей"! Но хочется сделать через макрос.
Вариант boa подошел в этом случае куда лучше. +1
Одно НО - оба варианта требуют открытия исходных файлов.
Может, есть вариант без открытия исходников решить задачу, или с поочередным открытием штук по 10-15-20?
Записан

boa

  • Глобальный модератор
  • Старожил
  • *****
  • Уважение: +32/-0
  • Оффлайн Оффлайн
  • Сообщений: 594
  • Доброта спасет мир...

Может, есть вариант без открытия исходников решить задачу, или с поочередным открытием штук по 10-15-20?

без открытия не знаю :(, а с поочередным открытием можно. Здесь смотрели?
Записан
Ничто не обходится нам так дешево и не ценится так дорого, как вежливость...  Мигель Сервантес де Сааведра

Виктория Зуева

  • Постоялец
  • ***
  • Уважение: +21/-0
  • Оффлайн Оффлайн
  • Сообщений: 316
  • curious

Вот накопала ссылок на английском, но, думаю, знающим термины VBA будет понятно.

Ресурсы про извлечение данных из файлов Excel:
http://www.mrexcel.com/forum/showthread.php?t=140187
Есть пример кода и ссылка - в ответе:
http://www.rondebruin.nl/tips.htm
Оттуда взято:
http://www.rondebruin.nl/copy3.htm
Там есть под заголовком Example workbook пример кода в файле.

Еще ресурс
Retrieving Data From Closed Excel Files Through A Macro:
http://www.bigresource.com/VB-Retrieving-Data-from-closed-Excel-Files-through-a-macro--W0fr1vyP.html#

И видео - может, не совсем в тему...
http://www.youtube.com/watch?v=pFgwa9nQTU0

Может, из этой кучи идей можно что-либо накопать по моему вопросу?
А именно - выборка данных из закрытых книг в файл-отчет (если он лежит в той же папке, что и исходные).


« Последнее редактирование: 06.07.2009, 00:49:50 от Виктория Зуева »
Записан

zhal

  • Новичок
  • *
  • Уважение: +1/-0
  • Оффлайн Оффлайн
  • Сообщений: 4

А вы можете еще раз уточнить, Вы частично решили для себя задачу ии нет?
Вот способ скрыть от пользовательских глаз открываемые макросом Excel-книги.
Основной смысл - это создание в макросе нового Excel приложения и изменение его свойста visible в false
Что не понятно - разъясню ;)

Sub
Sub OpenFiles()

Set myWb = ThisWorkbook ' Текущая книга, из которой запускаем макрос
Dim NewApp As New Excel.Application 'Новое Excel приложение, которое будет не видимым
Dim OpenBook As Workbook ' Открываемая не видимая книга
Dim FileDir As String 'Директория, в которой лежат открываемые файлы
Dim FileMask As String ' Маска фалов, которые открываем
Dim OpenFileName As String ' Наименование файла в директории

' Задаем директорию, в которой лежат файлы. Если она равна директории текущей книги,
' то можно задать FileDir = myWb.Path
FileDir = "c:\0\local_cc"
' Задаем маску файлов
FileMask = "*.xls"

NewApp.Visible = False ' Собственно делаем невидимым приложение, в котором будем открывать книги

' корректировка переменной с директорией, если та не содержит косую черту в конце
If Right(FileDir, 1) <> "\" Then
   FileDir = FileDir & "\"
End If

'Считываем наименование первого файла в папке
OpenFileName = Dir(FileDir & FileMask)
Do While OpenFileName <> "" ' Считываем наименования фалов в директории
   If FileDir & OpenFileName <> myWb.FullName Then ' Исключаем случай повторного открытия Главной книги
      NewApp.Workbooks.Open FileName:=FileDir & OpenFileName ' Открываем книгу
      Set OpenBook = NewApp.ActiveWorkbook ' Запоминаем ссылку на открытую книгу
      myWb.Activate ' Делаем Активной Главную книгу
     
      ' Делаем то, что нам нужно. К Главной книге обращаемся как к myWb, к открытой для считывания как к OpenBook
      Debug.Print OpenFileName ' Для отладки. Выводит имена открываемых файлов в immediate окно VBA. В Рабочем варианте закомментировать
     
     
      OpenBook.Close ' Закончили обработку текущей книги. Закрывам книгу
   End If
   OpenFileName = Dir ' Считываем наименование следующего файла в директории
Loop

NewApp.Quit 'закрываем не видимое приложение

End Sub

Записан

boa

  • Глобальный модератор
  • Старожил
  • *****
  • Уважение: +32/-0
  • Оффлайн Оффлайн
  • Сообщений: 594
  • Доброта спасет мир...

Виктория, вот файл, который будет работать с закрытыми книгами
Он их сам откроет и сам закроет. Время работы макроса, конечно, сильно возрастает, но думаю Вы сами сделаете для себя выбор.

P.S. Извините, что заставил себя ждать. Некогда было "голову поднять"
P.P.S. За ссылки спасибо, интересны, но опять же, работают по принципу "Открыл файл-Прочитал инфу-Закрыл". Нашел по Вашим ссылкам интересную инфу  Copy a range from closed workbooks (ADO)
, но разбираться пока не нашлось времени. Возможно, после изучения данного метода смогу модернизировать Ваш код.
Записан
Ничто не обходится нам так дешево и не ценится так дорого, как вежливость...  Мигель Сервантес де Сааведра

zhal

  • Новичок
  • *
  • Уважение: +1/-0
  • Оффлайн Оффлайн
  • Сообщений: 4

... вот файл, который будет работать с закрытыми книгами
Он их сам откроет и сам закроет.

Макрос работать будет ;), но ...
Открывая книги, делает их доступными для глаза и для внешнего вмешательства.
ИМХО в случае длительных запросов просто нельзя будет на компе заниматься другими делами. Если Excel-книга будет постоянно терять фокус, выполнение макроса может вылетать с ошибками.
ИМХО все-таки нужно открывать книги (из которых считываются данные) в новом невидимом application:

Sub ...
...
Dim NewApp As New Excel.Application 'Новое Excel приложение, которое будет не видимым
...
NewApp.Visible = False ' Собственно делаем невидимым приложение, в котором будем открывать книги
...
NewApp.Workbooks.Open FileName:=FileDir & OpenFileName ' Открываем книгу
...
NewApp.quit
End Sub

Относительно ADO. Это всего лишь способ доступа к данным. Он позволяет работать с таблицами Excel как с таблицами базы данных, с помощью SQL-запросов. ИМХО здесь не уместен, поскольку не требуется фильтровать строки и преобразовывать значения. Перебирать строки из Recordset придется точно также, как перебираются строки Excel-таблицы.
Записан

boa

  • Глобальный модератор
  • Старожил
  • *****
  • Уважение: +32/-0
  • Оффлайн Оффлайн
  • Сообщений: 594
  • Доброта спасет мир...

Открывая книги, делает их доступными для глаза и для внешнего вмешательства.
zhal, вот рабочая версия. Распакуйте архив во временную папку. Попробуйте во время выполнения макроса посмотреть или что-либо изменить в иных файлах кроме Отчета.

ИМХО все-таки нужно открывать книги (из которых считываются данные) в новом невидимом application:
Возможно ИМХО изменится ;)

P.S. Только не надо хитрить и расставлять точки остановки макроса :)
Записан
Ничто не обходится нам так дешево и не ценится так дорого, как вежливость...  Мигель Сервантес де Сааведра

boa

  • Глобальный модератор
  • Старожил
  • *****
  • Уважение: +32/-0
  • Оффлайн Оффлайн
  • Сообщений: 594
  • Доброта спасет мир...

ИМХО все-таки нужно открывать книги (из которых считываются данные) в новом невидимом application:
Надо отдать должное открытие в скрытом окне достаточно действенный способ sm_clap +1 и может быть использован во многих ситуациях...
« Последнее редактирование: 11.07.2009, 00:49:41 от boa »
Записан
Ничто не обходится нам так дешево и не ценится так дорого, как вежливость...  Мигель Сервантес де Сааведра

Виктория Зуева

  • Постоялец
  • ***
  • Уважение: +21/-0
  • Оффлайн Оффлайн
  • Сообщений: 316
  • curious

Спасибо за предложенное решение!
"Прикручиваю" к своим корявым данным. Еще бы с форматом отчета потом справиться... Есть еще
вопрос -
если еще из файла Отдела в Отчет надо "вытащить" значение именованной ячейки (имя - kod_otd), которую добавили в заголовок, то как это сделать?
Ячейка - в 3-й строке.
Записан

boa

  • Глобальный модератор
  • Старожил
  • *****
  • Уважение: +32/-0
  • Оффлайн Оффлайн
  • Сообщений: 594
  • Доброта спасет мир...

Еще бы с форматом отчета потом справиться...
воспользуйтесь макрорекодером, а потом в созданном макросе, как говорят скульпторы, уберите лишнее :)

...из файла Отдела в Отчет надо "вытащить" значение именованной ячейки (имя - kod_otd), которую добавили в заголовок, то как это сделать?
после строки
                Rezultat(i, 1) = Left(FileOtdel, Len(FileOtdel) - 4) 'обрезаем расширение названия файла
добавьте
                On Error Resume Next
                Rezultat(i, 1) = .Range("kod_otd") & " " & Left(FileOtdel, Len(FileOtdel) - 4)
« Последнее редактирование: 15.07.2009, 00:30:08 от boa »
Записан
Ничто не обходится нам так дешево и не ценится так дорого, как вежливость...  Мигель Сервантес де Сааведра

Виктория Зуева

  • Постоялец
  • ***
  • Уважение: +21/-0
  • Оффлайн Оффлайн
  • Сообщений: 316
  • curious

Ругается Excel на строчку в макросе:
 
ReDim Rezultat(1 To i, 1 To 4)  'посчитав, создаем массив в который потом занесем все данные
Я поняла, что если код отдела надо в отдельную ячейку, то в массиве Rezultat надо увеличить размерность до (1 To i, 1 To 5) и далее с результатами справлюсь (я надеюсь  :) ).
И еще - в каждый отчет от отдела добавлен титульный лист с реквизитными данными по отделу, на нем же будет ячейка с именем kod_otd (Лист 1, имя листа "Титул"), а сама таблица теперь будет на листе 2 "Отчет".
Надо ли изменить следующую строку?
With Workbooks(FileOtdel).Sheets(1)(я так понимаю, что надо...но как?)
 
Записан

boa

  • Глобальный модератор
  • Старожил
  • *****
  • Уважение: +32/-0
  • Оффлайн Оффлайн
  • Сообщений: 594
  • Доброта спасет мир...

Ругается Excel на строчку в макросе:
ReDim Rezultat(1 To i, 1 To 4)  'посчитав, создаем массив в который потом занесем все данныеЯ поняла, что если код отдела надо в отдельную ячейку, то в массиве Rezultat надо увеличить размерность до (1 To i, 1 To 5) и далее с результатами справлюсь (я надеюсь  :) ).
поняли правильно, но в прошлом примере, что бы не изменять размерность, я код отдела объединил с именем файла, хотя если у Вас есть реестр "код/название отдела", то тогда, конечно, лучше в отдельную ячейку, а потом, сопоставив, вывести красивое ИМЯ ОТДЕЛА.
И еще - в каждый отчет от отдела добавлен титульный лист с реквизитными данными по отделу, на нем же будет ячейка с именем kod_otd (Лист 1, имя листа "Титул"), а сама таблица теперь будет на листе 2 "Отчет".
Надо ли изменить следующую строку?
With Workbooks(FileOtdel).Sheets(1)(я так понимаю, что надо...но как?)
 
Да, и очень просто :)
With Workbooks(FileOtdel).Sheets("Отчет")либо
With Workbooks(FileOtdel).Sheets("Титул")соответственно.

на всяк.случ. прикрепляю архив
Записан
Ничто не обходится нам так дешево и не ценится так дорого, как вежливость...  Мигель Сервантес де Сааведра

Виктория Зуева

  • Постоялец
  • ***
  • Уважение: +21/-0
  • Оффлайн Оффлайн
  • Сообщений: 316
  • curious

Проблема!!!
В последнем макросе - newApplication в невидимом режиме открывается,
Dim newApp As New Excel.Application 'Новое Excel приложение
newApp.Visible = False
в него по очереди файлы загружаются, файлы "выгружаются" (т.е. закрываются),
newApp.Workbooks(FileOtdel).Close 'когда мы с файла "выжали все соки" - закрываем его
а вот для приложения команды закрытия нет... оно так и остается висеть, невидимое... ЧТО ДЕЛАТЬ?
Куда и что дописать?  ???
А то макрос три раза запустила - и 3 Excel-a "скрытые" повисли в памяти.
« Последнее редактирование: 17.07.2009, 16:42:52 от Виктория Зуева »
Записан

Виктория Зуева

  • Постоялец
  • ***
  • Уважение: +21/-0
  • Оффлайн Оффлайн
  • Сообщений: 316
  • curious

Эврика!
Нашла!!!

NewApp.Quit
после 2-го Loop надо вставить...
Закрыть чтобы "невидимое приложение"...
Записан

boa

  • Глобальный модератор
  • Старожил
  • *****
  • Уважение: +32/-0
  • Оффлайн Оффлайн
  • Сообщений: 594
  • Доброта спасет мир...
Записан
Ничто не обходится нам так дешево и не ценится так дорого, как вежливость...  Мигель Сервантес де Сааведра

Виктория Зуева

  • Постоялец
  • ***
  • Уважение: +21/-0
  • Оффлайн Оффлайн
  • Сообщений: 316
  • curious

Как в этом коде отключить автопересчет для newApp? (привожу часть кода)
Dim newApp As New Excel.Application 'Новое приложение в невидимиом режиме
newApp.Visible = False

TimeStart = GetTickCount
Application.ScreenUpdating = 0 'Отключаем автообновление
Application.Calculation = xlManual
Application.EnableCancelKey = xlDisabled    ' Запрет прерывания макроса

v_Path = ThisWorkbook.Path & "\"
FileOtdel = Dir(v_Path)
v_Mask = "XLS"

i = 0
    Do While FileOtdel <> ""
        If UCase(Right(FileOtdel, 3)) = v_Mask Then
            i = i + 1 ' здесь мы посчитаем сколько у нас файлов, соответствующих маске, в папке
        End If
        FileOtdel = Dir
    Loop

ReDim Rezultat(1 To i, 1 To 9) 'посчитав, создаем массив, в который потом занесем все данные

FileOtdel = Dir(v_Path)
i = 1
    Do While FileOtdel <> "" ' Запускаем цикл до тех пор пока в папке есть интересующие нас файлы
        If UCase(Right(FileOtdel, 3)) = v_Mask Then
'           MsgBox (v_iFileName)
        
        If Not FileOtdel = ThisWorkbook.Name Then
            newApp.Workbooks.Open Filename:=v_Path & FileOtdel 'открываем найденный файл

            With newApp.Workbooks(FileOtdel)
« Последнее редактирование: 21.07.2009, 23:17:51 от Виктория Зуева »
Записан

Виктория Зуева

  • Постоялец
  • ***
  • Уважение: +21/-0
  • Оффлайн Оффлайн
  • Сообщений: 316
  • curious

А то для каждого файла из папки "вываливается" запрос:
Записан

boa

  • Глобальный модератор
  • Старожил
  • *****
  • Уважение: +32/-0
  • Оффлайн Оффлайн
  • Сообщений: 594
  • Доброта спасет мир...

newApp.DisplayAlerts = False 'Отключаем окна диалогов скрытого Excel
Записан
Ничто не обходится нам так дешево и не ценится так дорого, как вежливость...  Мигель Сервантес де Сааведра
 



Темы без ответов

24.01.2020 14:03 На диаграмме Ганта несоответствие оси Y 1397
09.08.2019 14:09 Макрос для заполнения таблиц через форму 3166
18.07.2019 16:02 Рассылка почты из Excel при помощи почтовой программы TheBAT! 2778
09.07.2019 20:39 Кредит с уменьшением периода выплат 2878
28.05.2019 21:09 Сделать несколько скриптов для рабочей таблицы 3615
05.03.2019 17:00 Последовательный вывод таблиц Excel в один документ Word без шаблона 3473
05.03.2019 09:29 Нежелательные изменение размеров колонтитула при редактировании 3227
07.02.2019 01:36 Как удалить дубликаты из выпадающего связанного списка? 3429
20.01.2019 12:38 Все варианты частичного суммирования 3548
13.01.2019 12:24 Заполнение диапазона числами - в виде кластеров 2870





Яндекс цитирования msexcel.ru Яндекс.Метрика

Страница сгенерирована за 0.198 секунд. Запросов: 150.