Пользовательская функция суммы для ячеек с двумя значениями

Суммирование ячеек с двумя значениями - пользовательская функция

Данная функция предназначена для суммирования итогов и подитогов в таблице Excel, если в ячейках находятся сразу 2 значения
(к примеру, фактическое, и по плану), разделённые переводом строки (нажатием Alt + Enter)

При суммировании учитывается группировка строк.

Для суммирования несгруппированных строк используется функция СуммаПланФакт,
а для сгруппированных строк - функция СуммаПодитоговПланФакт

Примеры формул на листе Excel

  • =СуммаПодитоговПланФакт(D8:D9)
  • =СуммаПодитоговПланФакт(F8;H8;J8)
  • =СуммаПланФакт(D4:D10)

 

Код пользовательской функции (UDF):

Function СуммаПланФакт(ParamArray args() As Variant) As String
    Application.Volatile True
    Dim cell As Range, v1 As Double, v2 As Double
 
    For Index = LBound(args) To UBound(args)    ' перебираем все диапазоны ячеек
        If Not IsMissing(args(Index)) Then    ' если очередной аргумент присутствует
            If TypeName(args(Index)) = "Range" Then    ' если аргумент - диапазон ячеек
                For Each cell In args(Index).Cells    ' перебираем все ячейки в диапазоне

                    If cell.EntireRow.OutlineLevel = 1 Then
                        arr = Split(cell.Text, vbLf)
                        If UBound(arr) = 1 Then
                            v1txt = Trim(arr(0)): v2txt = Trim(arr(1))
                            v2txt = Replace(v2txt, "(", ""): v2txt = Replace(v2txt, ")", "")
                            v1txt = Replace(v1txt, ",", "."): v2txt = Replace(v2txt, ",", ".")
                            v1txt = Val(v1txt): v2txt = Val(Trim(v2txt))
                            v1 = v1 + v1txt: v2 = v2 + v2txt
                        End If
                    End If
 
 
                Next cell
            End If
        End If
    Next Index
 
    СуммаПланФакт = СуммаПланФакт & v1 & vbLf & "(" & v2 & ")"
End Function
 
 
Function СуммаПодитоговПланФакт(ParamArray args() As Variant) As String
    Application.Volatile True
    Dim cell As Range, v1 As Double, v2 As Double
 
    For Index = LBound(args) To UBound(args)    ' перебираем все диапазоны ячеек
        If Not IsMissing(args(Index)) Then    ' если очередной аргумент присутствует
            If TypeName(args(Index)) = "Range" Then    ' если аргумент - диапазон ячеек
                For Each cell In args(Index).Cells    ' перебираем все ячейки в диапазоне

                    If cell.EntireRow.OutlineLevel = 2 Then
                        arr = Split(cell.Text, vbLf)
                        If UBound(arr) = 1 Then
                            v1txt = Trim(arr(0)): v2txt = Trim(arr(1))
                            v2txt = Replace(v2txt, "(", ""): v2txt = Replace(v2txt, ")", "")
                            v1txt = Replace(v1txt, ",", "."): v2txt = Replace(v2txt, ",", ".")
                            v1txt = Val(v1txt): v2txt = Val(Trim(v2txt))
                            v1 = v1 + v1txt: v2 = v2 + v2txt
                        End If
                    End If
 
 
                Next cell
            End If
        End If
    Next Index
 
    СуммаПодитоговПланФакт = СуммаПодитоговПланФакт & v1 & vbLf & "(" & v2 & ")"
End Function

Единственное отличие функций - в значении параметра OutlineLevel (уровня группировки) обрабатываемых строк.

Пример - в прикреплённом файле (обратите внимание на формулы в серых ячейках)

Вложения:
DoubleSum.xls50 КБ

Комментарии

Отправить комментарий

Содержание этого поля является приватным и не предназначено к показу.
CAPTCHA
Подтвердите, пожалуйста, что вы - человек:
         ___    __  __  __  __          _   _ 
____ / _ \ | \/ | \ \/ / __ _ | | | |
|_ / | (_) | | |\/| | \ / / _` | | |_| |
/ / \__, | | | | | / \ | (_| | | _ |
/___| /_/ |_| |_| /_/\_\ \__, | |_| |_|
|_|
Введите код, изображенный в стиле ASCII-арт.

Не получается применить макрос? Не удаётся изменить код под свои нужды?

Оформите заказ у нас на сайте, не забыв прикрепить примеры файлов, и описать, что и как должно работать.