Пример:
Есть две папки - "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" итоговые данные по отделам "собирать" не ручками?
начну с конца :)
Цитата: Виктория Зуева от 25.06.2009, 12:17
2) Что-бы придумать, чтоб для папки "2квартал" в файл "Отчет 2квартал.xls" итоговые данные по отделам "собирать" не ручками?
в итоговой строке в одной и той же колонке я бы написал одинаковый для всех файлов текст типа "Общий итог"
тогда поиск номера итоговой стоки можно сделать так:
Do: iRow = iRow + 1
Loop Until Cells(iRow, [номер столбца]) = "Общий итог"
на выходе iRow будет = номеру искомой строки
Ячейка с текстом "Итого по отделу" присутствует во 2 столбце почти внизу каждого "Отчета". Ниже еще есть непустые строки. Я вот про ВПР думала по этому поводу.
А вот что делать с этим iRow? Его в модуль "отдела" или "отчета" прикручивать? ???
это в модуль отчета для сбора инфы с разных файлов
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. Если будут сложности, - выложите файлы-образцы
Я такие вещи делаю неизменяемым файлом без макросов, который после автозаполнения сохраняю в нужную папку.
Файл "Отчет" в папке "Отчеты2009". Он един для всех кварталов.
Порядок действий:
1) открыть все файлы в папке "nквартал" (n - номер квартала),
2) открыть файл "Отчет",
3) закрыть все файлы папки "nквартал".
В файле "Отчет" останутся все данные за квартал n.
Пункты 1 и 2 можно поменять местами.
Если случайно открыты файлы из разных папок (например 1квартал - отдел 1 и 2квартал - отдел 2), то в ячейке А1 - красная ругань, если все файлы из одной папки, то в А1 - № квартала.
Работает для 100 файлов, но можно увеличить.
ВПР в строке 5 нужно подогнать под родные файлы "отдел m" (вместо 2 поставить номер своего столбца с данными и изменить массив для поиска).
Виктория, посмотрите, это то?
Boroda, спасибо за ваш пример - взяла себе в "копилку идей"! Но хочется сделать через макрос.
Вариант boa подошел в этом случае куда лучше. +1
Одно НО - оба варианта требуют открытия исходных файлов.
Может, есть вариант без открытия исходников решить задачу, или с поочередным открытием штук по 10-15-20?
Цитата: Виктория Зуева от 02.07.2009, 16:45
Может, есть вариант без открытия исходников решить задачу, или с поочередным открытием штук по 10-15-20?
без открытия не знаю :(, а с поочередным открытием можно. Здесь (https://forum.msexcel.ru/microsoft_excel/vytaskivanie_iz_papki_faylov_excel_obedinenie_ih_v_odin_s_dob_imeni_fayla-t860.0.html) смотрели?
Вот накопала ссылок на английском, но, думаю, знающим термины 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
Может, из этой кучи идей можно что-либо накопать по моему вопросу?
А именно - выборка данных из закрытых книг в файл-отчет (если он лежит в той же папке, что и исходные).
А вы можете еще раз уточнить, Вы частично решили для себя задачу ии нет?
Вот способ скрыть от пользовательских глаз открываемые макросом 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
Виктория, вот файл, который будет работать с закрытыми книгами
Он их сам откроет и сам закроет. Время работы макроса, конечно, сильно возрастает, но думаю Вы сами сделаете для себя выбор.
P.S. Извините, что заставил себя ждать. Некогда было "голову поднять"
P.P.S. За ссылки спасибо, интересны, но опять же, работают по принципу "Открыл файл-Прочитал инфу-Закрыл". Нашел по Вашим ссылкам интересную инфу Copy a range from closed workbooks (ADO)
(http://www.rondebruin.nl/ado.htm), но разбираться пока не нашлось времени. Возможно, после изучения данного метода смогу модернизировать Ваш код.
Цитата: boa от 08.07.2009, 18:44
... вот файл, который будет работать с закрытыми книгами
Он их сам откроет и сам закроет.
Макрос работать будет ;), но ...
Открывая книги, делает их доступными для глаза и для внешнего вмешательства.
ИМХО в случае длительных запросов просто нельзя будет на компе заниматься другими делами. Если 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-таблицы.
Цитата: zhal от 09.07.2009, 14:43
Открывая книги, делает их доступными для глаза и для внешнего вмешательства.
zhal, вот рабочая версия. Распакуйте архив во временную папку. Попробуйте во время выполнения макроса
посмотреть или что-либо
изменить в иных файлах кроме Отчета.
Цитата: zhal от 09.07.2009, 14:43ИМХО все-таки нужно открывать книги (из которых считываются данные) в новом невидимом application:
Возможно ИМХО изменится ;)
P.S. Только не надо хитрить и расставлять точки остановки макроса :)
Цитата: zhal от 09.07.2009, 14:43
ИМХО все-таки нужно открывать книги (из которых считываются данные) в новом невидимом application:
Надо отдать должное открытие в скрытом окне достаточно действенный способ sm_clap +1 и может быть использован во многих ситуациях...
Спасибо за предложенное решение!
"Прикручиваю" к своим корявым данным. Еще бы с форматом отчета потом справиться... Есть еще
вопрос -
если еще из файла Отдела в Отчет надо "вытащить" значение именованной ячейки (имя - kod_otd), которую добавили в заголовок, то как это сделать?
Ячейка - в 3-й строке.
Цитата: Виктория Зуева от 14.07.2009, 23:26
Еще бы с форматом отчета потом справиться...
воспользуйтесь макрорекодером, а потом в созданном макросе, как говорят скульпторы, уберите лишнее :)
Цитата: Виктория Зуева от 14.07.2009, 23:26
...из файла Отдела в Отчет надо "вытащить" значение именованной ячейки (имя - 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)
Ругается 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)
(я так понимаю, что надо...но как?)
Цитата: Виктория Зуева от 15.07.2009, 11:33
Ругается Excel на строчку в макросе:
ReDim Rezultat(1 To i, 1 To 4) 'посчитав, создаем массив в который потом занесем все данные
Я поняла, что если код отдела надо в отдельную ячейку, то в массиве Rezultat надо увеличить размерность до (1 To i, 1 To 5) и далее с результатами справлюсь (я надеюсь :) ).
поняли правильно, но в прошлом примере, что бы не изменять размерность, я код отдела объединил с именем файла, хотя если у Вас есть реестр "код/название отдела", то тогда, конечно, лучше в отдельную ячейку, а потом, сопоставив, вывести красивое ИМЯ ОТДЕЛА.
Цитата: Виктория Зуева от 15.07.2009, 11:33
И еще - в каждый отчет от отдела добавлен титульный лист с реквизитными данными по отделу, на нем же будет ячейка с именем kod_otd (Лист 1, имя листа "Титул"), а сама таблица теперь будет на листе 2 "Отчет".
Надо ли изменить следующую строку?
With Workbooks(FileOtdel).Sheets(1)
(я так понимаю, что надо...но как?)
Да, и очень просто :)
With Workbooks(FileOtdel).Sheets("Отчет")либо
With Workbooks(FileOtdel).Sheets("Титул")соответственно.
на всяк.случ. прикрепляю архив
Проблема!!!
В последнем макросе - newApplication в невидимом режиме открывается,
Dim newApp As New Excel.Application 'Новое Excel приложение
newApp.Visible = False
в него по очереди файлы загружаются, файлы "выгружаются" (т.е. закрываются),
newApp.Workbooks(FileOtdel).Close 'когда мы с файла "выжали все соки" - закрываем его
а вот для приложения команды закрытия нет... оно так и остается висеть, невидимое... ЧТО ДЕЛАТЬ?
Куда и что дописать? ???
А то макрос три раза запустила - и 3 Excel-a "скрытые" повисли в памяти.
Эврика!
Нашла!!!
NewApp.Quit
после 2-го Loop надо вставить...
Закрыть чтобы "невидимое приложение"...
Да воздастся ищущему :)
Как в этом коде отключить автопересчет для 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)
А то для каждого файла из папки "вываливается" запрос:
newApp.DisplayAlerts = False 'Отключаем окна диалогов скрытого Excel