Автосуммирование по условию

[Naeel Maqsudov]

Стандартная функция СУММЕСЛИ работает ТОЛЬКО со гомогенными массивами (а не с массивами массивов разной мерности).

Предлагаю написать свою реализацию СУММЕСЛИ.

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

Function Arr(ParamArray X() As Variant) As Variant
Dim N As Integer, C As Variant, CC As Variant, Result() As Variant
N = 0
For Each C In X
  N = N + C.Cells.Count
Next
ReDim Result(1 To N)
N = 1
For Each C In X
  For Each CC In C.Cells
    Result(N) = CC
    N = N + 1
  Next
Next
Arr = Result
End Function

Function СУММЕСЛИ2(x1(), X, x2()) As Double
Dim r As Double, i As Long, XX
  r = 0: i = 1
  For Each XX In x1
    If XX = X Then r = r + x2(i)
    i = i + 1
  Next
  СУММЕСЛИ2 = r
End Function

Функция Arr производит нормализацию массива, т.е. все выделенные ячейки и диапазоны превращает о один одномерный массив-строку.

Функция суммесли2 умеет работать с любыми одномерными массивами, а не только с гомогенными диапазонами. Однако она может проверять только РАВЕНСТВО. Чтобы проверять случаи больше, меньше, не равно и пр. надо усложнить условие "If XX = X". Думаю, это будет не сложно. Для простоты можно ввести еще один аргумент, а можно довести эту функцию до полной аналогии с ее предшественницей, анализируя первые символы аргумента X (нет ли там знаков сравнения?).

[Naeel Maqsudov]

Пример вызова

=СУММЕСЛИ2(arr(A21:B23;B26:B27);"a";arr(D21:E23;E26:E27))