Сумма значений ячеек на существующих и вновь добавленных листах

[4ivanch]

Здравствуйте, помогите пожалуйста. Необходимо создать макрос или написать такую формулу, которая бы позволила выводить сумму значений соответствующих ячеек на всех листах книги, как существующих, так и вновь добавленных, а результат бы выводился на первом листе. Есть макрос, который добавляет новый лист с расчетом, необходимо просуммировать расчет на каждом листе, который был добавлен и существующих, и свести результаты в единую таблицу.

[pashulka]

Если новые листы добавляются между вторым и последним листом, то можно использовать трёхмерное суммирование, например :

=СУММ('Лист№2:Лист№5'!B2)

[pashulka]

Если по каким-то причинам использование вышеопубликованной формулы, применительно к поставленной задаче, нежелательно или невозможно, то вот несколько примеров суммирования данных ячейки [B2] всех рабочих листов активной книги, кроме первого.

Код: Выделить всё

Private Sub Test()
    Dim iCount%, iResult#
    
    With ActiveWorkbook.Worksheets
         For iCount = 2 To .Count
             iResult = iResult + .Item(iCount).Cells(2, 2)
         Next
    End With
    MsgBox "Сумма всех ячеек B2=" & iResult, , ""
End Sub

Применение вызовет ошибку, если в любой из суммируемых ячеек окажется текст(за исключением чисел, сохранённых как текст) или значение ошибки.

Код: Выделить всё

Private Sub Test2()
    Dim iLists As Sheets, iCount%, iResult#
    Set iLists = ActiveWorkbook.Worksheets
    
    For iCount = 2 To iLists.Count
        iResult = Application.Sum(iResult, iLists(iCount).[B2])
    Next
    MsgBox "Сумма всех ячеек B2=" & iResult, , ""
End Sub

Применение вызовет ошибку, если в любой из суммируемых ячеек окажется значение ошибки.

Код: Выделить всё

Private Sub Test3()
    Dim iLists As Sheets, iCell As Range, iCount%, iResult#
    Set iLists = ActiveWorkbook.Worksheets
    
    For iCount = 2 To iLists.Count
        Set iCell = iLists(iCount).Range("B2")
        If IsNumeric(iCell) = True Then
           iResult = iResult + iCell.Value
        End If
    Next
    MsgBox "Сумма всех ячеек B2=" & iResult, , ""
End Sub

Универсальный вариант.

[pashulka]

И разумеется трехмерное суммирование можно осуществлять и программно, например :

Код: Выделить всё

With ActiveWorkbook.Worksheets
     iFormula = "=SUM('" & .Item(2).Name & ":" & .Item(.Count).Name & "'!B2)"

     .Item(1).Range("B2").Formula = iFormula
End With

Если же вводить формулу не хочется (хотя после ввода мы можем заменить эту формулу на её значение), то и это решаемо :

Код: Выделить всё

Dim iLists As Sheets, iFormula$, iAddress$, iResult As Variant
Set iLists = ActiveWorkbook.Worksheets

iAddress = "C2" ' "A1:B100"
iAddress = Application.ConvertFormula(iAddress, xlA1, Application.ReferenceStyle)
iFormula = "SUM('" & iLists(2).Name & ":" & iLists(iLists.Count).Name & "'!" & iAddress & ")"
iResult = Evaluate(iFormula)

If Not IsError(iResult) Then
   MsgBox "Сумма всех ячеек " & iAddress & "=" & iResult, , ""
Else
   MsgBox "Как минимум в одной из ячеек есть значение ошибки", , ""
End If

[4ivanch]

Спасибо большое за ответ, буду разбираться теперь с предложенным кодом и применять.

[4ivanch]

Если по каким-то причинам использование вышеопубликованной формулы, применительно к поставленной задаче, нежелательно или невозможно, то вот несколько примеров суммирования данных ячейки [B2] всех рабочих листов активной книги, кроме первого.

Код: Выделить всё

Private Sub Test()
    Dim iCount%, iResult#
    
    With ActiveWorkbook.Worksheets
         For iCount = 2 To .Count
             iResult = iResult + .Item(iCount).Cells(2, 2)
         Next
    End With
    MsgBox "Сумма всех ячеек B2=" & iResult, , ""
End Sub

Применение вызовет ошибку, если в любой из суммируемых ячеек окажется текст(за исключением чисел, сохранённых как текст) или значение ошибки.

Код: Выделить всё

Private Sub Test2()
    Dim iLists As Sheets, iCount%, iResult#
    Set iLists = ActiveWorkbook.Worksheets
    
    For iCount = 2 To iLists.Count
        iResult = Application.Sum(iResult, iLists(iCount).[B2])
    Next
    MsgBox "Сумма всех ячеек B2=" & iResult, , ""
End Sub

Применение вызовет ошибку, если в любой из суммируемых ячеек окажется значение ошибки.

Код: Выделить всё

Private Sub Test3()
    Dim iLists As Sheets, iCell As Range, iCount%, iResult#
    Set iLists = ActiveWorkbook.Worksheets
    
    For iCount = 2 To iLists.Count
        Set iCell = iLists(iCount).Range("B2")
        If IsNumeric(iCell) = True Then
           iResult = iResult + iCell.Value
        End If
    Next
    MsgBox "Сумма всех ячеек B2=" & iResult, , ""
End Sub

Универсальный вариант.

Мне подходит первый вариант, единственно, мне необходимо, чтобы результат выводился на первом листе в ячейку, которую я назначу в коде, как дописать такую строку? Или лучше опять напишите код целиком с этой строкой, заранее спасибо.

[pashulka]

На всякий случай уточню, ибо это важно :
- если в суммируемых ячейках находятся только числа, то все три варианта выдадут одну и туже сумму.
- если хотя бы в одной из суммируемых ячейках, окажется текст, то первый вариант выдаст ошибку, за исключением случаев, когда число будет сохранено как текст, например "1"), второй вариант проигнорирует любой текст, в т.ч. и "1"), третий будет суммировать "1", но игнорировать текст, типа "сто рублей"
- наконец, в случае, если в любой из ячейке, подлежащих суммированию, обнаружится значение ошибки, в т.ч. и результат вычисления формулы, типа #ДЕЛ/0! или #Н/Д , то применение первых двух вариантов приведёт к возникновению ошибки и только третий(универсальный) позволит Вам получить сумму.

Код: Выделить всё

Private Sub Test()
    Dim iCount%, iResult#
   
    With ActiveWorkbook.Worksheets
         For iCount = 2 To .Count
             iResult = iResult + .Item(iCount).Cells(2, 2)
         Next
         .Item(1).Cells(2, 2) = iResult
    End With   
End Sub

Код: Выделить всё

Private Sub Test_1()
    Dim iCount%, iResult#
   
    With ActiveWorkbook.Worksheets
         For iCount = 2 To .Count
             iResult = iResult + .Item(iCount).Range("A1")
         Next
         .Item(1).Range("A1") = iResult
    End With   
End Sub

и т.д. и т.п.

P.S. При ответе, цитировать предыдущее сообщение вовсе не обязательно.

[pashulka]

К слову сказать, если ячейки, которые подлежат суммированию, не разбросаны "хаотически" по всему листу, а представляют собой смежные ячейки, проще говоря, некий список, то, в некоторых случаях, решить такую задачу можно с помощью консолидации (Данные-Консолидация) или сводной таблицы (Данные-Сводная таблица)

[4ivanch]

Для одной ячейки результат верен, а когда я пишу повтор для другой ячеки она суммирует мне все вместе и получается ошибка. мне необходимо выполнить такое суммирование для нескольких ячеек за одну операцию, может это возможно сделать?

[pashulka]

Я не телепат, поэтому найти ошибку в неопубликованном коде, мне довольно сложно а если серьёзно, то вот мой вариант для нескольких ячеек (разумеется, адреса ячеек необходимо указать свои)

Код: Выделить всё

Private Sub getTotalSumOfChooseCell()
    Dim iCount%, iResult#, iLists As Sheets
    Dim iArrAddress As Variant, iAddress As Variant
   
    iArrAddress = Array("A1", "B10", "C1", "F12", "S100") ' и так далее

    Set iLists = ActiveWorkbook.Worksheets
    For Each iAddress In iArrAddress
        For iCount = 2 To iLists.Count
            iResult = iResult + iLists(iCount).Range(iAddress)
        Next
        iLists(1).Range(iAddress) = iResult: iResult = 0
    Next
End Sub