Уважаемые специалисты!
Имеется большое количество таблиц одинаковой структуры. Каждая таблица - отдельная книга. Все книги расположены в одной папке.
Необходимо произвести суммирование аналогичных ячеек в отдельный файл.
На сайте я нашел похожую тему с макросом.
Однако у меня отличается структура таблиц.
Можно ли адаптировать макрос под мои таблицы?
В суммирующей таблице очистку и суммирование данных нужно проводить с ячейки В4.
Кроме того, наименования таблиц (по колонке А и строке 3) связаны с суммирующей таблицей ссылками. Макрос суммирует везде, где имеются ссылки.
Можно ли ячейки с суммой 0 оставлять пустыми?
Пример прилагаю.
Заранее благодарен!
Код макроса, который нужно адаптировать.
Код |
---|
Option Explicit Sub SummAll() Dim BazaWb As Workbook 'текущая книга (общий файл) Dim BazaSht As Worksheet 'лист для суммы в общем файле Dim TempWb As Workbook 'по-очерёдно открываемый файл Dim TempSht As Worksheet 'лист для суммы в по-очерёдно открываемом файле Dim iTempFileName As String 'имя по-очерёдно открываемого файла Dim iPath As String 'путь к папке, где лежат все файлы Dim iCol As Long 'строка в файле Dim iRow As Long 'столбец в файле Dim iRowTmp As Long 'последняя заполненная строка в файле по столбцам Dim iColTmp As Long 'последний заполненный столбец в файле Dim iNumFiles As Long 'количество открываемых файлов With Application .ScreenUpdating = False .DisplayAlerts = False .Calculation = xlManual Set BazaWb = ThisWorkbook Set BazaSht = BazaWb.ActiveSheet iPath = BazaWb.Path & "\" iTempFileName = Dir(iPath & "*.xls") 'удаляем данные перед суммированием, если нужно With BazaSht .Range(.Cells(2, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, .Cells(1, Columns.Count).End(xlToLeft).Column)).ClearContents End With 'по очереди открываем файлы из папки Do While iTempFileName <> "" If iTempFileName <> BazaWb.Name Then Set TempWb = .Workbooks.Open _ (Filename:=iPath & iTempFileName, UpdateLinks:=False, ReadOnly:=True) iNumFiles = iNumFiles + 1 Set TempSht = TempWb.ActiveSheet 'Рабочая книга не должна быть защищена паролем With TempSht 'всего столбцов в открытом листе iColTmp = .Cells(1, Columns.Count).End(xlToLeft).Column For iCol = 1 To iColTmp 'номер последней заполненой строки в столбце iRowTmp = .Cells(Rows.Count, 1).End(xlUp).Row For iRow = 2 To iRowTmp BazaSht.Cells(iRow, iCol).Value = BazaSht.Cells(iRow, iCol).Value + .Cells(iRow, iCol).Value Next iRow Next iCol End With TempWb.Close saveChanges:=False End If iTempFileName = Dir Loop .Calculation = xlAutomatic .DisplayAlerts = True .ScreenUpdating = True End With MsgBox "Данные обработаны из " & iNumFiles & " файлов!", vbInformation, "Конец" End Sub |