Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Microsoft Office и VBA программирование > Microsoft Office Excel
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 25.10.2011, 16:31   #1
Viktorkv
Пользователь
 
Регистрация: 07.06.2010
Сообщений: 62
По умолчанию Обьединение листов разных книг.

Доброго времени суток.)
У меня проблема следующая. Необходимо суммировать данные 5 листов, расположенные в 5 книгах. Количество суммируемых книг может варьироваться от 2 и до 100.
Т.е. суммировать нужно все книги, расположенные в определенной папке, которую задаем при запуске макроса.
Работаю в 2003 офисе
Плиз, подскажите макрос.
Всем откликнувшимся огромная благодарность, выручайте)
Вложения
Тип файла: rar Пример.rar (23.4 Кб, 12 просмотров)
Viktorkv вне форума Ответить с цитированием
Старый 25.10.2011, 17:53   #2
alex77755
Форумчанин
 
Аватар для alex77755
 
Регистрация: 14.02.2009
Сообщений: 753
По умолчанию

И что таблицы во всех книгах одинаковые?
помогу решить контрольные VB6, VBA (недорого)
Alex77755@mail.ru
alex77755 вне форума Ответить с цитированием
Старый 25.10.2011, 17:56   #3
Viktorkv
Пользователь
 
Регистрация: 07.06.2010
Сообщений: 62
По умолчанию

Цитата:
Сообщение от alex77755 Посмотреть сообщение
И что таблицы во всех книгах одинаковые?
Да, одинаковые, разное лишь наполнение
Viktorkv вне форума Ответить с цитированием
Старый 25.10.2011, 18:29   #4
alex77755
Форумчанин
 
Аватар для alex77755
 
Регистрация: 14.02.2009
Сообщений: 753
По умолчанию

Тогда сделать книгу "ИТОГ" с пустой таблицей и на кнопку навесить макрос типа:
Код:
Sub test()

  Dim Folder As String
  Dim wb As String
  Dim objWb As Workbook
  Dim workWb As Workbook
  Dim i As Integer
  Dim R, C
  Dim Q As Worksheet
  Dim REZ()
  Dim T()
  Application.ScreenUpdating = False
    Range("B10:AM29").Select
    Selection.ClearContents
    Range("A1:AM1").Select
 Set workWb = ActiveWorkbook  'Запоминаем активную книгу
 REZ = workWb.ActiveSheet.Range(Cells(7, 1), Cells(29, 39)).Value
  'Начинаем читать файлы из папки
  wb = Dir(workWb.Path & "\*.xls")
  While Len(wb) > 0 And wb <> "ИТОГ.xls"
    wb = workWb.Path & "\" & wb
    Set objWb = Workbooks.Open(wb)
        For Each Q In objWb.Sheets
         Q.Select
            m = Q.Range(Cells(7, 1), Cells(29, 39)).Value
            For R = 4 To 23
                For C = 2 To 39
                   REZ(R, C) = REZ(R, C) + m(R, C)
                Next C
            Next R
        Next
    objWb.Close False
    wb = Dir 'читаем следующий файл
  Wend
 workWb.ActiveSheet.Range(Cells(7, 1), Cells(29, 39)).Value = REZ
  Application.ScreenUpdating = True
 MsgBox "Ok", 64, ""
End Sub
помогу решить контрольные VB6, VBA (недорого)
Alex77755@mail.ru

Последний раз редактировалось alex77755; 25.10.2011 в 18:36. Причина: Внёс поправки
alex77755 вне форума Ответить с цитированием
Старый 25.10.2011, 18:31   #5
Viktorkv
Пользователь
 
Регистрация: 07.06.2010
Сообщений: 62
По умолчанию

Спасибо за помощь, сейчас попробую.
Viktorkv вне форума Ответить с цитированием
Старый 25.10.2011, 18:47   #6
Viktorkv
Пользователь
 
Регистрация: 07.06.2010
Сообщений: 62
По умолчанию

Файлы открывает, идет процесс, но суммирования нет
Viktorkv вне форума Ответить с цитированием
Старый 25.10.2011, 18:49   #7
Viktorkv
Пользователь
 
Регистрация: 07.06.2010
Сообщений: 62
По умолчанию

Все правильно, табуляцию нарушил я. Можно сделать, чтобы шапка и форматирование в книге "ИТОГ" сохранились?
Viktorkv вне форума Ответить с цитированием
Старый 25.10.2011, 18:54   #8
Viktorkv
Пользователь
 
Регистрация: 07.06.2010
Сообщений: 62
По умолчанию

И чтобы был запрос на папку, где хранятся книги для объединения.
В любом случае спасибо). Я уже два дня пытаюсь что-нить сочинить.
Viktorkv вне форума Ответить с цитированием
Старый 25.10.2011, 21:10   #9
alex77755
Форумчанин
 
Аватар для alex77755
 
Регистрация: 14.02.2009
Сообщений: 753
По умолчанию

Цитата:
Все правильно, табуляцию нарушил я. Можно сделать, чтобы шапка и форматирование в книге "ИТОГ" сохранились?
??
А разве они не сохраняются? У меня только нулевые значения показываются.
Поставил в параметрах не показывать.

Цитата:
И чтобы был запрос на папку, где хранятся книги для объединения.
Код:
Option Explicit
Sub test()

  Dim Folder As String
  Dim wb As String
  Dim objWb As Workbook
  Dim workWb As Workbook
'  Dim i As Integer
  Dim R, C
  Dim Q As Worksheet
  Dim REZ()
  Dim M()
  Application.ScreenUpdating = False
    Range("B10:AM29").Select
    Selection.ClearContents
    Range("A1:AM1").Select
 Set workWb = ActiveWorkbook  'Запоминаем активную книгу
 REZ = workWb.ActiveSheet.Range(Cells(7, 1), Cells(29, 39)).Value
 
   'Показываем диалог выбора папки
  With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "Выберите папку, файлы в которой нужно обработать"
    .ButtonName = "Выбрать"
    .AllowMultiSelect = False
    If .Show Then Folder = .SelectedItems(1) Else Exit Sub
  End With
  'Начинаем читать файлы из папки
  wb = Dir(Folder & Application.PathSeparator & "*.xls")
  While Len(wb) > 0 And wb <> "ИТОГ.xls"
   wb = Folder & Application.PathSeparator & wb
    Set objWb = Workbooks.Open(wb)
        For Each Q In objWb.Sheets
         Q.Select
            M = Q.Range(Cells(7, 1), Cells(29, 39)).Value
            For R = 4 To 23
                For C = 2 To 39
                   REZ(R, C) = REZ(R, C) + M(R, C)
                Next C
            Next R
        Next
    objWb.Close False
    wb = Dir 'читаем следующий файл
  Wend
 workWb.ActiveSheet.Range(Cells(7, 1), Cells(29, 39)).Value = REZ
  Application.ScreenUpdating = True
  MsgBox "Ok", 64, ""
End Sub
помогу решить контрольные VB6, VBA (недорого)
Alex77755@mail.ru
alex77755 вне форума Ответить с цитированием
Старый 25.10.2011, 21:25   #10
Viktorkv
Пользователь
 
Регистрация: 07.06.2010
Сообщений: 62
По умолчанию

И последняя просьба) Скорее всего таблицы могут быть не везде одинаковые. Суммирование должно быть по строчкам 8-12 16 20 24...100.

Последний раз редактировалось Viktorkv; 25.10.2011 в 23:48.
Viktorkv вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

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


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Транспонирование множества данных из разных книгах или из разных листов на 1 лист посредством макроса Тантана Microsoft Office Excel 6 18.12.2014 13:04
Сбор данных только первых листов разных книг Dilmira Microsoft Office Excel 6 25.04.2011 17:50
Объединение книг и некоторых листов ? vovik07 Microsoft Office Excel 5 20.05.2010 11:52
Обьединение разных типов даных женя2010 Microsoft Office Excel 3 21.04.2010 12:56
копирование листов из закрытых книг mephist Microsoft Office Excel 4 10.07.2009 17:18