MyTetra Share
Делитесь знаниями!
Как просуммировать данные с нескольких листов, в том числе по условию
16.03.2019
23:43
Раздел: !Закладки - VBA - Excel - Листы

Как просуммировать данные с нескольких листов, в том числе по условию

В данной статье я хочу рассказать, как можно просуммировать данные на одном листе из других листов. К примеру: на листах Январь, Февраль и Март расположены данные по продажам, а под ними итог. Допустим, это будет ячейка D7. Если структура всех таблиц одинакова (одинаковое кол-во строк, товар может различаться) и Итог расположен во всех таблицах в одной ячейке, то можно воспользоваться простой формулой:
=СУММ(Январь:Март!D7)

Подобная ссылка на диапазоны называется трехмерной ссылкой. Если между листом Январь и Март добавить еще какой-нибудь лист - то данные с него будут также автоматически просуммированы. Поэтому необходимо следить, чтобы указывались только нужные листы. Минус в том, что таким образом можно просуммировать данные только ячеек листа, расположенных в одном и том же диапазоне.

Но, если необходимо будет просуммировать данные по отдельным товарам со всех листов, а товар расположен в хаотичном порядке, разном для каждого листа и количество строк различается, то здесь такая формула не подойдет. Можно воспользоваться формулой массива, которая несколько неудобна именно в таком виде:
=СУММПРОИЗВ(СУММЕСЛИ(ДВССЫЛ({"Январь":"Февраль":"Март":"Апрель":"Май":"Июнь"}&"!B3:B100");B2;ДВССЫЛ({"Январь":"Февраль":"Март":"Апрель":"Май":"Июнь"}&"!C3:C100")))

"Январь":"Февраль":"Март":"Апрель":"Май":"Июнь" - имена листов, с которых происходит суммирование. Не буду останавливаться подробно на всех вложенных функциях. Про СУММЕСЛИ можно прочитать в этой статье. ДВССЫЛ используется для создания ссылки на диапазон, состоящей из имени листа и адреса ячеек: Январь!B3:B100, Февраль!B3:B100, Март!B3:B100, Апрель!B3:B100, Май!B3:B100, Июнь!B3:B100. Т.е. мы в формуле переибраем все указанные листы и диапазоны в них.

Важно: если в имени листа встречается пробел, либо иной знак препинания, то имя листа необходимо заключать в апострофы: "'Январь 2014'":"'Февраль 2014'":"Март":"Апрель":"Май":"Июнь"
либо ставить апострофы заранее для всех листов:
ДВССЫЛ("'"&{"Январь":"Февраль":"Март":"Апрель":"Май":"Июнь"}&"'!C3:C100")

B3:B100- диапазон с критериями(при необходимости указать больше строк).
C3:C100 - диапазон суммирования
(при необходимости указать больше строк).

В чем главное неудобство - необходимо так или иначе указывать листы, с которых суммировать. Это очень неудобно, если листов много. Во вложении ниже эта формула представлена в двух вариантах: как выше и с использованием дополнительного столбца для перечисления листов(формула в данном случае получается более универсальной и короткой).
Скачать пример суммирования с листов формулой

  Tips_All_SumIf_AllSheets_Formula.xls (67,5 KiB, 4 824 скачиваний)

Возможно, есть и иные способы суммирования формулой. Может даже есть способ суммировать, не указывая имена листов, но у меня не получилось так сделать без использования VBA. Поэтому я написал свою пользовательскую функцию:

Function All_SumIf(rRange As Range, rCriteria As Range, rSumRange As Range, Optional bAllSh As Boolean = True) Dim wsSh As Worksheet, sRange As String, sSumRange As String sRange = Right(rRange.Address, Len(rRange.Address) - InStr(rRange.Address, "!")) sSumRange = Right(rSumRange.Address, Len(rSumRange.Address) - InStr(rSumRange.Address, "!")) For Each wsSh In Sheets If bAllSh Then If wsSh.Name <> Application.Caller.Parent.Name Then All_SumIf = All_SumIf + Application.SumIf(wsSh.Range(sRange), rCriteria, wsSh.Range(sSumRange)) End If Else If wsSh.Index < Application.Caller.Parent.Index Then All_SumIf = All_SumIf + Application.SumIf(wsSh.Range(sRange), rCriteria, wsSh.Range(sSumRange)) End If End If Next wsSh End Function


1

2

3

4

5

6

7

8

9

10

11

12

13

14

15

16

Function All_SumIf(rRange As Range, rCriteria As Range, rSumRange As Range, Optional bAllSh As Boolean = True)

    Dim wsSh As Worksheet, sRange As String, sSumRange As String

    sRange = Right(rRange.Address, Len(rRange.Address) - InStr(rRange.Address, "!"))

    sSumRange = Right(rSumRange.Address, Len(rSumRange.Address) - InStr(rSumRange.Address, "!"))

    For Each wsSh In Sheets

        If bAllSh Then

            If wsSh.Name <> Application.Caller.Parent.Name Then

                All_SumIf = All_SumIf + Application.SumIf(wsSh.Range(sRange), rCriteria, wsSh.Range(sSumRange))

            End If

        Else

            If wsSh.Index < Application.Caller.Parent.Index Then

                All_SumIf = All_SumIf + Application.SumIf(wsSh.Range(sRange), rCriteria, wsSh.Range(sSumRange))

            End If

        End If

    Next wsSh

End Function

Чтобы правильно воспользоваться кодом советую прочитать статью: Что такое функция пользователя(UDF)?

Аргументы функции аналогичны стандартной СУММЕСЛИ, только в конце добавлен еще один, необязательный.

rRange - Ссылка на диапазон ячеек. Указывается диапазон значений, среди которых необходимо искать критерий.
rCriteria - Ссылка на одну ячейку. Указывается ячейка, в которой содержится значение, данные по которому надо просуммировать.
rSumRange - Ссылка на диапазон ячеек. Указывается диапазон сумм или чисел, которые необходимо просуммировать на основании критерия.
bAllSh - Необязательный аргумент. Если не указан, или указано значение 1 или ИСТИНА, то будут суммироваться значения со всех листов, кроме листа, на котором записана функция. Если указано значение 0 или ЛОЖЬ, то будут суммироваться значения с листов, расположенных до листа, на котором записана функция.

Применение обеих функций вы найдете в примере к статье.
Скачать пример

  Tips_All_SumIf_Few_Sheets.xls (57,5 KiB, 2 897 скачиваний)

Дополнил статью функцией, которая суммирует данные только с указанных листов, либо со всех, кроме листа с функцией:

Function All_SumIf(rRange As Range, rCriteria As Range, rSumRange As Range, Optional sSheets = "") Dim wsSh As Worksheet, sRange As String, sSumRange As String, asSheets, li As Long sRange = Right(rRange.Address, Len(rRange.Address) - InStr(rRange.Address, "!")) sSumRange = Right(rSumRange.Address, Len(rSumRange.Address) - InStr(rSumRange.Address, "!")) If sSheets = "" Then For Each wsSh In Worksheets If wsSh.Name <> Application.Caller.Parent.Name Then sSheets = sSheets & "?" & wsSh.Name Next wsSh sSheets = Mid$(sSheets, 2) End If asSheets = Split(sSheets, "?") For li = LBound(asSheets) To UBound(asSheets) Set wsSh = Sheets(asSheets(li)) If Not wsSh Is Nothing Then All_SumIf = All_SumIf + Application.SumIf(wsSh.Range(sRange), rCriteria, wsSh.Range(sSumRange)) End If Next li End Function


1

2

3

4

5

6

7

8

9

10

11

12

13

14

15

16

17

18

Function All_SumIf(rRange As Range, rCriteria As Range, rSumRange As Range, Optional sSheets = "")

    Dim wsSh As Worksheet, sRange As String, sSumRange As String, asSheets, li As Long

    sRange = Right(rRange.Address, Len(rRange.Address) - InStr(rRange.Address, "!"))

    sSumRange = Right(rSumRange.Address, Len(rSumRange.Address) - InStr(rSumRange.Address, "!"))

    If sSheets = "" Then

        For Each wsSh In Worksheets

            If wsSh.Name <> Application.Caller.Parent.Name Then sSheets = sSheets & "?" & wsSh.Name

        Next wsSh

        sSheets = Mid$(sSheets, 2)

    End If

    asSheets = Split(sSheets, "?")

    For li = LBound(asSheets) To UBound(asSheets)

        Set wsSh = Sheets(asSheets(li))

        If Not wsSh Is Nothing Then

            All_SumIf = All_SumIf + Application.SumIf(wsSh.Range(sRange), rCriteria, wsSh.Range(sSumRange))

        End If

    Next li

End Function

rRange - Ссылка на диапазон ячеек. Указывается диапазон значений, среди которых необходимо искать критерий.
rCriteria - Ссылка на одну ячейку. Указывается ячейка, в которой содержится значение, данные по которому надо просуммировать.
rSumRange - Ссылка на диапазон ячеек. Указывается диапазон сумм или чисел, которые необходимо просуммировать на основании критерия.
sSheets - Необязательный аргумент. Указываются имена листов книги, с которых надо суммировать данные. Имена листов должны быть записаны через вопросительный знак: Февраль?Март. Если аргумент не указан или равен пустой ячейке, то будут суммироваться значения со всех листов, кроме листа, на котором записана функция.
Скачать пример

  Tips_All_SumIf_Show_Sheets.xls (59,5 KiB, 2 021 скачиваний)

Очередное дополнение статьи - функция, в которой помимо перечисления листов можно указать книгу, в которой эти листы просматривать:

Function All_SumIf(rRange As Range, rCriteria As Range, rSumRange As Range, Optional sSheets = "", Optional wsAnotherWB As String = "") Dim wsSh As Worksheet, sRange As String, sSumRange As String, asSheets, li As Long Dim wbB As Workbook If wsAnotherWB = "" Then Set wbB = Application.Caller.Parent.Parent Else Set wbB = Workbooks(wsAnotherWB) End If sRange = Right(rRange.Address, Len(rRange.Address) - InStr(rRange.Address, "!")) sSumRange = Right(rSumRange.Address, Len(rSumRange.Address) - InStr(rSumRange.Address, "!")) If sSheets = "" Then For Each wsSh In wbB.Worksheets If wsSh.Name <> Application.Caller.Parent.Name Then sSheets = sSheets & "?" & wsSh.Name Next wsSh sSheets = Mid$(sSheets, 2) End If asSheets = Split(sSheets, "?") For li = LBound(asSheets) To UBound(asSheets) Set wsSh = wbB.Sheets(asSheets(li)) If Not wsSh Is Nothing Then All_SumIf = All_SumIf + Application.SumIf(wsSh.Range(sRange), rCriteria, wsSh.Range(sSumRange)) End If Next li End Function


1

2

3

4

5

6

7

8

9

10

11

12

13

14

15

16

17

18

19

20

21

22

23

24

25

Function All_SumIf(rRange As Range, rCriteria As Range, rSumRange As Range, Optional sSheets = "", Optional wsAnotherWB As String = "")

    Dim wsSh As Worksheet, sRange As String, sSumRange As String, asSheets, li As Long

    Dim wbB As Workbook

    If wsAnotherWB = "" Then

        Set wbB = Application.Caller.Parent.Parent

    Else

        Set wbB = Workbooks(wsAnotherWB)

    End If

 

    sRange = Right(rRange.Address, Len(rRange.Address) - InStr(rRange.Address, "!"))

    sSumRange = Right(rSumRange.Address, Len(rSumRange.Address) - InStr(rSumRange.Address, "!"))

    If sSheets = "" Then

        For Each wsSh In wbB.Worksheets

            If wsSh.Name <> Application.Caller.Parent.Name Then sSheets = sSheets & "?" & wsSh.Name

        Next wsSh

        sSheets = Mid$(sSheets, 2)

    End If

    asSheets = Split(sSheets, "?")

    For li = LBound(asSheets) To UBound(asSheets)

        Set wsSh = wbB.Sheets(asSheets(li))

        If Not wsSh Is Nothing Then

            All_SumIf = All_SumIf + Application.SumIf(wsSh.Range(sRange), rCriteria, wsSh.Range(sSumRange))

        End If

    Next li

End Function

Аргументы и их использование полностью совпадают с описанием выше. Опишу только последний аргумент:
wsAnotherWB - Необязательный аргумент. Указываются имя книги, в которой будут просматриваться листы, указанные параметром sSheets. Если аргумент wsAnotherWB не указан - листы просматриваются в книге, с листа которой вызвана функция. Если какого-либо из указанных листов не будет в указанной книге - функция вернет ошибку.

Так же в этом разделе:
 
MyTetra Share v.0.52
Яндекс индекс цитирования