Сумирование с заполнением отдельной таблицы с разных книг - Мир MS Excel

Регистрация

Напомнить пароль

= Мир MS Excel/Сумирование с заполнением отдельной таблицы с разных книг - Мир MS Excel

Страница 1 из 2 1 2 »
Модератор форума: китин, _Boroda_, DrMini

Сумирование с заполнением отдельной таблицы с разных книг (Макросы/Sub)

Сумирование с заполнением отдельной таблицы с разных книг

Дата: Вторник, 06.10.2015, 15:41 | Сообщение № 1

Группа: Пользователи

Ранг: Участник

Сообщений: 67

Репутация: 0 ±

Замечаний: 0% ±

Excel 2010

Задача:
Есть основная книга, называется "Общая.xlsx", есть другие книги, "Январь.xlsx", "Февраль.xlsx", "Март.xlsx" и т.д... в каждой книге есть свои листы "День1", "День2", "День3" и т.д., на листе есть таблица, в которой вперемешку разбросаны данные. Например для того чтобы скопировать с одной книги в другую, необходимо в книге "Январь.xlsx", на листе "День1" просуммировать ячейки A1:A3:A7:A9 и т.д., сумму необходимо вставить в таблицу которая находится в Книге "Общая.xlsx", на лист "Главная" в ячейку А5 ...
в книге "Январь.xlsx", на листе "День2" просуммировать ячейки A1:A3:A7:A9 и т.д., сумму необходимо вставить в таблицу которая находится в Книге "Общая.xlsx", на лист "Главная" в ячейку B5
и т.д.

Ответить

Дата: Вторник, 06.10.2015, 16:44 | Сообщение № 2

Группа: Модераторы

Ранг: Старожил

Сообщений: 2198

Репутация: 902 ±

Замечаний: 0% ±

Excel 2010, 2016

akaDemik, без примера только такой ответ:
примерно такой код[vba]

Код

Set sh = ThisWorkbook.ActiveSheet
Workbooks("Общая.xlsx").Sheets("Главная").Cells(5, sh.Index) = WorksheetFunction.Sum(sh.Range("A3,A7,A9,A11"))

[/vba]

ЯД: 410013299366744 WM: R193491431804

Ответить

Дата: Среда, 07.10.2015, 10:27 | Сообщение № 3

Группа: Пользователи

Ранг: Участник

Сообщений: 67

Репутация: 0 ±

Замечаний: 0% ±

Excel 2010

Насколько я понял этот код для одной книги, у меня их больше 5
Вот пример

К сообщению приложен файл: 5533939.xlsx (8.6 Kb) · 0068642.xlsx (9.6 Kb)

Ответить

Дата: Среда, 07.10.2015, 11:30 | Сообщение № 4

Группа: Пользователи

Ранг: Новичок

Сообщений: 18

Репутация: 2 ±

Замечаний: 60% ±

Excel 2003;Excel 2013

akaDemik, добрый день! Попробуйте..

К сообщению приложен файл: 5533939.xlsm (17.3 Kb)

www.vbastudio.ru

Ответить

Дата: Среда, 07.10.2015, 11:34 | Сообщение № 5

Группа: Пользователи

Ранг: Новичок

Сообщений: 18

Репутация: 2 ±

Замечаний: 60% ±

Excel 2003;Excel 2013

Кол-во файлов для обработки можно указывать любое, главное , чтобы они были формата как Ваш прикрепленный файл..

www.vbastudio.ru

Ответить

Дата: Среда, 07.10.2015, 12:07 | Сообщение № 6

Группа: Пользователи

Ранг: Участник

Сообщений: 67

Репутация: 0 ±

Замечаний: 0% ±

Excel 2010

Viv, у меня пара ламерских вопросов:
[vba]

Код

Set RG1 = wb.Worksheets(1).Range("A5:C9")
'Почистим
RG1.Clear

[/vba]
обязательно чистить перед заполнением новых данных?

[vba]

Код

thisFName = ThisWorkbook.FullName
'Отключаем запрос на подтверждение
Application.DisplayAlerts = False

[/vba]
для чего это?

[vba]

Код

'Спросим
fName = Application.GetOpenFilename(MultiSelect:=True)

[/vba]
это неудобно так как файлов может быть от 5 до 15 (не все файлы могут быть доступны)...каждый раз открывать файлы неудобно, также у 2 из них может быть другая структура таблицы
проще прописать по каждому файлу отдельно, с учетом того, что его может не быть в папке, значит информация не заполняется, а макрос идет по другим доступным файлам

Ответить

Дата: Среда, 07.10.2015, 12:21 | Сообщение № 7

Группа: Пользователи

Ранг: Новичок

Сообщений: 18

Репутация: 2 ±

Замечаний: 60% ±

Excel 2003;Excel 2013

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

www.vbastudio.ru

Ответить

Дата: Среда, 07.10.2015, 12:34 | Сообщение № 8

Группа: Пользователи

Ранг: Участник

Сообщений: 67

Репутация: 0 ±

Замечаний: 0% ±

Excel 2010

Цитата Viv, 07.10.2015 в 12:21, в сообщении № 7

а последнее для удобства (можно сразу указать все необходимые файлы)...

но там код написан под открытие файла, мне это необязательно
надо четко прописать ""Январь.xlsx", на листе "День2" просуммировать ячейки A1:A3:A7:A9
также важный момент, чтоб не было ошибки, если файла в папке не оказалось

Ответить

Дата: Среда, 07.10.2015, 13:08 | Сообщение № 9

Группа: Пользователи

Ранг: Новичок

Сообщений: 18

Репутация: 2 ±

Замечаний: 60% ±

Excel 2003;Excel 2013

akaDemik, так это проще, удалите лишнее, например так, а ошибку при открытии проверьте On Error.. путь "C:\Январь.xlsx"

К сообщению приложен файл: 3196866.xlsm (16.5 Kb)

www.vbastudio.ru

Ответить

Дата: Среда, 07.10.2015, 14:55 | Сообщение № 10

Группа: Пользователи

Ранг: Участник

Сообщений: 67

Репутация: 0 ±

Замечаний: 0% ±

Excel 2010

Цитата Viv, 07.10.2015 в 13:08, в сообщении № 9

путь "C:\Январь.xlsx"

если файл находится в папке C:\ - проблем нет
мне надо чтоб файл открывался с той же директории, где расположен файл
[vba]

Код

Workbooks.Open Filename:="Январь.xlsx"

[/vba]
с этим кодом ничего не происходит

Ответить

Дата: Среда, 07.10.2015, 15:22 | Сообщение № 11

Группа: Пользователи

Ранг: Новичок

Сообщений: 18

Репутация: 2 ±

Замечаний: 60% ±

Excel 2003;Excel 2013

файл с данными откроется из той же папки, где будет лежать рабочий файл..

К сообщению приложен файл: 9834302.xlsm (16.6 Kb)

www.vbastudio.ru

Ответить

Дата: Среда, 07.10.2015, 16:28 | Сообщение № 12

Группа: Пользователи

Ранг: Участник

Сообщений: 67

Репутация: 0 ±

Замечаний: 0% ±

Excel 2010

пробовал добавить следующие книги...
[vba]

Код

Sub IMPORT()
Dim srcBook
Set wb = ThisWorkbook
Set wf = WorksheetFunction
   ' Открываем
   On Error GoTo ERR
      Set srcBook = Workbooks.Open(Filename:=wb.Path & "\Январь.xlsx", ReadOnly:=True, UpdateLinks:=0)
     'Вставим
     wb.Sheets("Главная").Cells(5, 1) = wf.Sum(srcBook.Sheets("День1").Range("A3,A7,A9,A11"))
     wb.Sheets("Главная").Cells(6, 1) = wf.Sum(srcBook.Sheets("День2").Range("A3,A7,A9,A11"))
     wb.Sheets("Главная").Cells(7, 1) = wf.Sum(srcBook.Sheets("День3").Range("A3,A7,A9,A11"))

      srcBook.Close SaveChanges:=False

  Set srcBook = Workbooks.Open(Filename:=wb.Path & "\Февраль.xlsx", ReadOnly:=True, UpdateLinks:=0)
     'Вставим
     wb.Sheets("Главная").Cells(5, 2) = wf.Sum(srcBook.Sheets("День1").Range("A3,A7,A9,A11"))
     wb.Sheets("Главная").Cells(6, 2) = wf.Sum(srcBook.Sheets("День2").Range("A3,A7,A9,A11"))
     wb.Sheets("Главная").Cells(7, 2) = wf.Sum(srcBook.Sheets("День3").Range("A3,A7,A9,A11"))

      srcBook.Close SaveChanges:=False

  Set srcBook = Workbooks.Open(Filename:=wb.Path & "\Март.xlsx", ReadOnly:=True, UpdateLinks:=0)
     'ÂВставим
     wb.Sheets("Главная").Cells(5, 3) = wf.Sum(srcBook.Sheets("День1").Range("A3,A7,A9,A11"))
     wb.Sheets("Главная").Cells(6, 3) = wf.Sum(srcBook.Sheets("День2").Range("A3,A7,A9,A11"))
     wb.Sheets("Главная").Cells(7, 3) = wf.Sum(srcBook.Sheets("День3").Range("A3,A7,A9,A11"))

      srcBook.Close SaveChanges:=False

ERR:
End Sub

[/vba]
при этом если в папке нет файла Февраль.xlsx, но есть Январь.xlsx и Март.xlsx, макрос отрабатывает только Январь, а Март остается пустым т.к. ошибка на Феврале
пробовал через функцию Next
[vba]

Код

On Error Resume Next

[/vba]
но не сильно знаком с данной функцией

пробовал добавить следующие книги...
[vba]

Код

Sub IMPORT()
Dim srcBook
Set wb = ThisWorkbook
Set wf = WorksheetFunction
   ' Открываем
   On Error GoTo ERR
      Set srcBook = Workbooks.Open(Filename:=wb.Path & "\Январь.xlsx", ReadOnly:=True, UpdateLinks:=0)
     'Вставим
     wb.Sheets("Главная").Cells(5, 1) = wf.Sum(srcBook.Sheets("День1").Range("A3,A7,A9,A11"))
     wb.Sheets("Главная").Cells(6, 1) = wf.Sum(srcBook.Sheets("День2").Range("A3,A7,A9,A11"))
     wb.Sheets("Главная").Cells(7, 1) = wf.Sum(srcBook.Sheets("День3").Range("A3,A7,A9,A11"))

      srcBook.Close SaveChanges:=False

  Set srcBook = Workbooks.Open(Filename:=wb.Path & "\Февраль.xlsx", ReadOnly:=True, UpdateLinks:=0)
     'Вставим
     wb.Sheets("Главная").Cells(5, 2) = wf.Sum(srcBook.Sheets("День1").Range("A3,A7,A9,A11"))
     wb.Sheets("Главная").Cells(6, 2) = wf.Sum(srcBook.Sheets("День2").Range("A3,A7,A9,A11"))
     wb.Sheets("Главная").Cells(7, 2) = wf.Sum(srcBook.Sheets("День3").Range("A3,A7,A9,A11"))

      srcBook.Close SaveChanges:=False

  Set srcBook = Workbooks.Open(Filename:=wb.Path & "\Март.xlsx", ReadOnly:=True, UpdateLinks:=0)
     'ÂВставим
     wb.Sheets("Главная").Cells(5, 3) = wf.Sum(srcBook.Sheets("День1").Range("A3,A7,A9,A11"))
     wb.Sheets("Главная").Cells(6, 3) = wf.Sum(srcBook.Sheets("День2").Range("A3,A7,A9,A11"))
     wb.Sheets("Главная").Cells(7, 3) = wf.Sum(srcBook.Sheets("День3").Range("A3,A7,A9,A11"))

      srcBook.Close SaveChanges:=False

ERR:
End Sub

[/vba]
при этом если в папке нет файла Февраль.xlsx, но есть Январь.xlsx и Март.xlsx, макрос отрабатывает только Январь, а Март остается пустым т.к. ошибка на Феврале
пробовал через функцию Next
[vba]

Код

On Error Resume Next

[/vba]
но не сильно знаком с данной функциейakaDemik

Ответить

Сообщениепробовал добавить следующие книги...
[vba]

Код

Sub IMPORT()
Dim srcBook
Set wb = ThisWorkbook
Set wf = WorksheetFunction
   ' Открываем
   On Error GoTo ERR
      Set srcBook = Workbooks.Open(Filename:=wb.Path & "\Январь.xlsx", ReadOnly:=True, UpdateLinks:=0)
     'Вставим
     wb.Sheets("Главная").Cells(5, 1) = wf.Sum(srcBook.Sheets("День1").Range("A3,A7,A9,A11"))
     wb.Sheets("Главная").Cells(6, 1) = wf.Sum(srcBook.Sheets("День2").Range("A3,A7,A9,A11"))
     wb.Sheets("Главная").Cells(7, 1) = wf.Sum(srcBook.Sheets("День3").Range("A3,A7,A9,A11"))

      srcBook.Close SaveChanges:=False

  Set srcBook = Workbooks.Open(Filename:=wb.Path & "\Февраль.xlsx", ReadOnly:=True, UpdateLinks:=0)
     'Вставим
     wb.Sheets("Главная").Cells(5, 2) = wf.Sum(srcBook.Sheets("День1").Range("A3,A7,A9,A11"))
     wb.Sheets("Главная").Cells(6, 2) = wf.Sum(srcBook.Sheets("День2").Range("A3,A7,A9,A11"))
     wb.Sheets("Главная").Cells(7, 2) = wf.Sum(srcBook.Sheets("День3").Range("A3,A7,A9,A11"))

      srcBook.Close SaveChanges:=False

  Set srcBook = Workbooks.Open(Filename:=wb.Path & "\Март.xlsx", ReadOnly:=True, UpdateLinks:=0)
     'ÂВставим
     wb.Sheets("Главная").Cells(5, 3) = wf.Sum(srcBook.Sheets("День1").Range("A3,A7,A9,A11"))
     wb.Sheets("Главная").Cells(6, 3) = wf.Sum(srcBook.Sheets("День2").Range("A3,A7,A9,A11"))
     wb.Sheets("Главная").Cells(7, 3) = wf.Sum(srcBook.Sheets("День3").Range("A3,A7,A9,A11"))

      srcBook.Close SaveChanges:=False

ERR:
End Sub

[/vba]
при этом если в папке нет файла Февраль.xlsx, но есть Январь.xlsx и Март.xlsx, макрос отрабатывает только Январь, а Март остается пустым т.к. ошибка на Феврале
пробовал через функцию Next
[vba]

Код

On Error Resume Next

[/vba]
но не сильно знаком с данной функцией

Автор - akaDemik
Дата добавления - 07.10.2015 в 16:28

Дата: Среда, 07.10.2015, 16:40 | Сообщение № 13

Группа: Модераторы

Ранг: Старожил

Сообщений: 2198

Репутация: 902 ±

Замечаний: 0% ±

Excel 2010, 2016

akaDemik, проверить наличие файла можно так:
[vba]

Код

Dim oFileSystemObject As Object: Set oFileSystemObject = CreateObject("Scripting.FileSystemObject")
If oFileSystemObject.FileExists(wb.Path & "\Январь.xlsx") Then
'открываем, копируем, закрываем...
End If

[/vba]

ЯД: 410013299366744 WM: R193491431804

Ответить

Дата: Среда, 07.10.2015, 17:00 | Сообщение № 14

Группа: Пользователи

Ранг: Новичок

Сообщений: 18

Репутация: 2 ±

Замечаний: 60% ±

Excel 2003;Excel 2013

[vba]

Код

On Error GoTo ERR

[/vba] в случае ошибки оператор GoTo отправляет на метку ERR:

www.vbastudio.ru

Ответить

Дата: Среда, 07.10.2015, 17:18 | Сообщение № 15

Группа: Пользователи

Ранг: Участник

Сообщений: 67

Репутация: 0 ±

Замечаний: 0% ±

Excel 2010

Manyasha, сложный код, но помог

Цитата Viv, 07.10.2015 в 17:00, в сообщении № 14

в случае ошибки оператор GoTo отправляет на метку ERR:

но ведь на метке ERR: - пусто, а как прописать следующую итерацию, я не понял

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

Ответить

Дата: Среда, 07.10.2015, 17:47 | Сообщение № 16

Группа: Модераторы

Ранг: Старожил

Сообщений: 2198

Репутация: 902 ±

Замечаний: 0% ±

Excel 2010, 2016

akaDemik, пробуйте. Запихала Вашу обработку книг в цикл (и по дням аналогично)...Массивы месяцев и дней сами расширите.
Раскраску ячеек тоже добавила, но для следующих вопросов, не касающихся

Цитата

Суммирование с заполнением отдельной таблицы с разных книг

создавайте отдельные темы.

К сообщению приложен файл: 1234.xlsm (17.6 Kb)

ЯД: 410013299366744 WM: R193491431804

Сообщение отредактировал Manyasha - Среда, 07.10.2015, 17:49

Ответить

Дата: Среда, 07.10.2015, 18:27 | Сообщение № 17

Группа: Пользователи

Ранг: Новичок

Сообщений: 18

Репутация: 2 ±

Замечаний: 60% ±

Excel 2003;Excel 2013

пробуйте..

К сообщению приложен файл: 9437034.xlsm (16.4 Kb)

www.vbastudio.ru

Ответить

Дата: Четверг, 08.10.2015, 10:48 | Сообщение № 18

Группа: Пользователи

Ранг: Участник

Сообщений: 67

Репутация: 0 ±

Замечаний: 0% ±

Excel 2010

Цитата Manyasha, 07.10.2015 в 17:47, в сообщении № 16

Запихала Вашу обработку книг в цикл (и по дням аналогично)...Массивы месяцев и дней сами расширите.

код интересный и сокращенный, но не совсем подходит т.к. я писал выше:

Цитата akaDemik, 07.10.2015 в 12:07, в сообщении № 6

открывать файлы неудобно, также у 2 из них может быть другая структура таблицы

но все равно спасибо +1
мне больше подходит код от Viv, тоже плюсую в карму
только немного подправил закрашивание, т.к. мне надо не ячейку в красный, а текст
[vba]

Код

.Font.Color = vbRed

[/vba]

Ответить

Дата: Четверг, 08.10.2015, 11:15 | Сообщение № 19

Группа: Модераторы

Ранг: Старожил

Сообщений: 2198

Репутация: 902 ±

Замечаний: 0% ±

Excel 2010, 2016

Совсем не поняла

...
Вот это, по-вашему, не открывает книги (я так понимаю это код Viv)

Цитата akaDemik, 07.10.2015 в 16:28, в сообщении № 12

On Error GoTo ERR
Set srcBook = Workbooks.Open(Filename:=wb.Path & "\Январь.xlsx", ReadOnly:=True, UpdateLinks:=0)

а это уже открывает (тоже самое, только в цикле)?

Цитата Manyasha, 07.10.2015 в 17:47, в сообщении № 16

If oFileSystemObject.FileExists(bookName) Then
Set srcBook = Workbooks.Open(Filename:=bookName, ReadOnly:=True, UpdateLinks:=0)

ЯД: 410013299366744 WM: R193491431804

Ответить

Дата: Четверг, 08.10.2015, 11:27 | Сообщение № 20

Группа: Пользователи

Ранг: Участник

Сообщений: 67

Репутация: 0 ±

Замечаний: 0% ±

Excel 2010

Цитата Manyasha, 08.10.2015 в 11:15, в сообщении № 19

Совсем не поняла

тогда попробую объяснить...
у книг Январь, Февраль, Март, одна структура и расположение ячеек, у книги Апрель - другая, у книги Май - третья
поэтому для каждой книги надо конкретно прописывать какие ячейки суммировать

Ответить

Сумирование с заполнением отдельной таблицы с разных книг (Макросы/Sub)

Страница 1 из 2
1
2
»

© 2010-2026 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!