Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

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

 

= Мир MS Excel/сумма ячеек разных книг с листами - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: _Boroda_, Manyasha, SLAVICK, китин  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » сумма ячеек разных книг с листами (Макросы/Sub)
сумма ячеек разных книг с листами
TVkills Дата: Четверг, 04.02.2021, 19:45 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 26
Репутация: 0 ±
Замечаний: 20% ±

Excel 2010
Добрый день, уважаемые форумчане, помогите доделать макрос для создания сводной таблицы. Возможно уже есть готовые решения, но найти самостоятельно не получается.
Есть форма на нескольких листах с названиями и заголовками, в которую необходимо проставить сумму аналогичных по форме, но с разным названием таблиц в одной общей папке (данные филиалы присылают по электронной почте).
Сейчас есть макрос, позволяющий суммировать значения в заданном диапазоне (столбцах), но это не удобно, потому как приходится каждый раз заходить в редактирование, править его и по новой запускать.
[vba]
Код
Sub Кнопка1_Щелчок()

Dim r As Range, ccell As Range, wb As Workbook, svodwb As Workbook, awb As Workbook, s$, sExt$, i&
Dim wsSh As Worksheet, wsDataSheet As Worksheet, lastrow&
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Set objFSO = CreateObject("Scripting.FileSystemObject")

'MsgBox "=" & awb.FullName
On Error Resume Next
Set objFolder = objFSO.GetFolder([B1])
If Err Then
  MsgBox "Ошибочное имя каталога " & [B1]
  Exit Sub
End If

Set svodwb = Workbooks.Open([B2])
If Err Then
  MsgBox "Невозможно открыть сводный файл " & [B2]
  Exit Sub
End If

Set awb = ThisWorkbook
s = "Обработано:"
'Set r = Range("E9:E29") 'задание диапазона суммирования
'r.ClearContents

' Очистим сводный файлы
For Each wsSh In svodwb.Worksheets
              
  ' последнюю строчку ищем по столбцу A номер 1
  lastrow = wsSh.Cells(Rows.Count, 1).End(xlUp).Row
  Set r = wsSh.Range("E9:E" & lastrow) 'задание диапазона суммирования
  r.ClearContents
              
Next wsSh
                

'проход по всем файлам в папке "\files"
For Each objFile In objFolder.Files
    sExt = LCase(objFSO.GetExtensionName(objFile.Name))
    If (sExt = "xls") Or (sExt = "xlsx") Then

        If Not ((objFile.Path = awb.FullName) Or (objFile.Path = svodwb.FullName) Or (Left(objFile.Name, 2) = "~$")) Then
            Set wb = Workbooks.Open(objFile)
            If Err Then
                MsgBox ("Ошибка при открытии файла " & objFile)
                Err.Clear
            Else
                i = i + 1
                s = s & vbCr & i & "." & objFile
                
                For Each wsSh In svodwb.Worksheets
                    
                  ' последнюю строчку ищем по столбцу A номер 1
                  lastrow = wsSh.Cells(Rows.Count, 1).End(xlUp).Row
                  Set r = wsSh.Range("E9:E" & lastrow) 'задание диапазона суммирования
                  For Each ccell In r
                      ccell.Value = ccell.Value + wb.Sheets(wsSh.Name).Range(ccell.Address)
                  Next ccell
                    
                Next wsSh
                
                
                'проход по ячейкам
                '    For Each cel In r
                '   cel.Value = cel.Value + wb.Sheets("п5").Range(cel.Address)
                '   Next
                wb.Close False
            End If
        End If
    End If
Next
MsgBox s

End Sub
[/vba]
Сделать так, чтобы проводилось сложение по всем ячейкам диапазона, наверное, сложно - ведь там в диапазоне есть и титул, шапка, заголовки...
а вот сделать так, чтобы диапазон каждый раз при запуске запрашивался у пользователя, наверное, можно.
по сути это добавить в начало строчки, которые были в первоначальном макросе:
Код:

[vba]
Код
'Выбираем диапазон выборки с книг
Set iBeginRange = Application.InputBox("Выберите диапазон сбора данных." & vbCrLf & _
"1. При выборе только одной ячейки данные будут собраны со всех листов начиная с этой ячейки. " & _
vbCrLf & "2. При выделении нескольких ячеек данные будут собраны только с указанного диапазона всех листов.", Type:=8)
'для указания диапазона без диалогового окна:
'Set iBeginRange = Range("A1:A10") 'диапазон указывается нужный
'Если диапазон не выбран - завершаем процедуру
If iBeginRange Is Nothing Then Exit Sub
[/vba]

ну и ещё там, где цикл суммирования идёт, немного изменить.


Сообщение отредактировал TVkills - Четверг, 04.02.2021, 19:46
 
Ответить
СообщениеДобрый день, уважаемые форумчане, помогите доделать макрос для создания сводной таблицы. Возможно уже есть готовые решения, но найти самостоятельно не получается.
Есть форма на нескольких листах с названиями и заголовками, в которую необходимо проставить сумму аналогичных по форме, но с разным названием таблиц в одной общей папке (данные филиалы присылают по электронной почте).
Сейчас есть макрос, позволяющий суммировать значения в заданном диапазоне (столбцах), но это не удобно, потому как приходится каждый раз заходить в редактирование, править его и по новой запускать.
[vba]
Код
Sub Кнопка1_Щелчок()

Dim r As Range, ccell As Range, wb As Workbook, svodwb As Workbook, awb As Workbook, s$, sExt$, i&
Dim wsSh As Worksheet, wsDataSheet As Worksheet, lastrow&
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Set objFSO = CreateObject("Scripting.FileSystemObject")

'MsgBox "=" & awb.FullName
On Error Resume Next
Set objFolder = objFSO.GetFolder([B1])
If Err Then
  MsgBox "Ошибочное имя каталога " & [B1]
  Exit Sub
End If

Set svodwb = Workbooks.Open([B2])
If Err Then
  MsgBox "Невозможно открыть сводный файл " & [B2]
  Exit Sub
End If

Set awb = ThisWorkbook
s = "Обработано:"
'Set r = Range("E9:E29") 'задание диапазона суммирования
'r.ClearContents

' Очистим сводный файлы
For Each wsSh In svodwb.Worksheets
              
  ' последнюю строчку ищем по столбцу A номер 1
  lastrow = wsSh.Cells(Rows.Count, 1).End(xlUp).Row
  Set r = wsSh.Range("E9:E" & lastrow) 'задание диапазона суммирования
  r.ClearContents
              
Next wsSh
                

'проход по всем файлам в папке "\files"
For Each objFile In objFolder.Files
    sExt = LCase(objFSO.GetExtensionName(objFile.Name))
    If (sExt = "xls") Or (sExt = "xlsx") Then

        If Not ((objFile.Path = awb.FullName) Or (objFile.Path = svodwb.FullName) Or (Left(objFile.Name, 2) = "~$")) Then
            Set wb = Workbooks.Open(objFile)
            If Err Then
                MsgBox ("Ошибка при открытии файла " & objFile)
                Err.Clear
            Else
                i = i + 1
                s = s & vbCr & i & "." & objFile
                
                For Each wsSh In svodwb.Worksheets
                    
                  ' последнюю строчку ищем по столбцу A номер 1
                  lastrow = wsSh.Cells(Rows.Count, 1).End(xlUp).Row
                  Set r = wsSh.Range("E9:E" & lastrow) 'задание диапазона суммирования
                  For Each ccell In r
                      ccell.Value = ccell.Value + wb.Sheets(wsSh.Name).Range(ccell.Address)
                  Next ccell
                    
                Next wsSh
                
                
                'проход по ячейкам
                '    For Each cel In r
                '   cel.Value = cel.Value + wb.Sheets("п5").Range(cel.Address)
                '   Next
                wb.Close False
            End If
        End If
    End If
Next
MsgBox s

End Sub
[/vba]
Сделать так, чтобы проводилось сложение по всем ячейкам диапазона, наверное, сложно - ведь там в диапазоне есть и титул, шапка, заголовки...
а вот сделать так, чтобы диапазон каждый раз при запуске запрашивался у пользователя, наверное, можно.
по сути это добавить в начало строчки, которые были в первоначальном макросе:
Код:

[vba]
Код
'Выбираем диапазон выборки с книг
Set iBeginRange = Application.InputBox("Выберите диапазон сбора данных." & vbCrLf & _
"1. При выборе только одной ячейки данные будут собраны со всех листов начиная с этой ячейки. " & _
vbCrLf & "2. При выделении нескольких ячеек данные будут собраны только с указанного диапазона всех листов.", Type:=8)
'для указания диапазона без диалогового окна:
'Set iBeginRange = Range("A1:A10") 'диапазон указывается нужный
'Если диапазон не выбран - завершаем процедуру
If iBeginRange Is Nothing Then Exit Sub
[/vba]

ну и ещё там, где цикл суммирования идёт, немного изменить.

Автор - TVkills
Дата добавления - 04.02.2021 в 19:45
InExSu Дата: Четверг, 04.02.2021, 22:50 | Сообщение № 2
Группа: Проверенные
Ранг: Ветеран
Сообщений: 618
Репутация: 94 ±
Замечаний: 0% ±

Excel 2010
Привет!

Обидно:
кто такие объяснения понимает, не может помочь,
а кто может помочь - не понимает.
:-)


На сохранение второго закона термодинамики: яндекс.кошелёк 410012113235839
 
Ответить
СообщениеПривет!

Обидно:
кто такие объяснения понимает, не может помочь,
а кто может помочь - не понимает.
:-)

Автор - InExSu
Дата добавления - 04.02.2021 в 22:50
TVkills Дата: Пятница, 05.02.2021, 14:14 | Сообщение № 3
Группа: Пользователи
Ранг: Новичок
Сообщений: 26
Репутация: 0 ±
Замечаний: 20% ±

Excel 2010
InExSu, ответил в личку.
 
Ответить
СообщениеInExSu, ответил в личку.

Автор - TVkills
Дата добавления - 05.02.2021 в 14:14
Мир MS Excel » Вопросы и решения » Вопросы по VBA » сумма ячеек разных книг с листами (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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