Формула СУММПРОИЗВ

[DiemonStar]

а что мешает сделать примерно так (проверял на примере файла):

Sub Sum()
  Set R = [A1]
  I = 3
  While [A1].Offset(, I) = "№"
    Set R = Union(R, [A1].Offset(, I))
    I = I + 3
  Wend
  Set R = R.EntireColumn.SpecialCells(xlCellTypeConstants)
  Set Dic = CreateObject("Scripting.Dictionary")
  With Dic
    For Each Cod In R
      If IsNumeric(Cod.Offset(, 2)) Then
        .Item(Cod & "|" & Cod.Offset(, 1)) = .Item(Cod & "|" & Cod.Offset(, 1)) + Cod.Offset(, 2)
      End If
    Next Cod
    [A12].Resize(.Count).Value = Application.WorksheetFunction.Transpose(.Keys)
    [B12].Resize(.Count).Value = Application.WorksheetFunction.Transpose(.Items)
  End With
End Sub

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

[staniiislav]

Примерно понял, спасибо! Буду пробовать

[staniiislav]

Сообщение от DiemonStar

а что мешает сделать примерно так (проверял на примере файла):

Спасибо большое за помощь! немного накидали работы, попозже все проверю и отпишусь!

[Hugo121]

Ну я предлагал примерно тоже самое.
1.Только для ускорения сперва взять данные в массив и перебирать его (а не ячейки листа).
2.Выгружать результат не на лист, а в виртуальный массив, потому что
3.всё это дело упаковать в UDF, для чего этот массив и нужен.

+ не нужно запускать/выполнять код
+ результат внешне будет точно как заказано (количество строк/столбцов пааметров не важно)
- сложнее этот код написать
- сложнее ввести формулу на лист - нужно выделить весь диапазон

[DiemonStar]

1.Только для ускорения сперва взять данные в массив и перебирать его (а не ячейки листа).

тогда можно для простоты выбор столбцов вынести в событие, например, по открытию книг или активации листа (по-идее же столбцы добавляться не должны, или должны, но редко), а в функции оставить только пересечение со строками и сохранение в массив.

Ну я предлагал примерно тоже самое.

У меня был практически готовый пример, сделанный, кстати, на базе макроса автора темы) немного доработать - дело недолгое.

[staniiislav]

Добрый день! Извините что долго не появлялся, работой загрузили. Не могли бы Вы дать пример с подобной УДФ функцией, чтобы быстрее я сообразил как и что? Спасибо!

[Hugo121]

Готовой "подобной" под задачу не нашёл, есть просто демонстрационный код массивной UDF кажется Казанского:

Выделите диапазон 3*3 ячейки (например B5:D7)
Введите в строке формул =ReturnArray()
Нажмите Ctrl-Shift-Enter

Public Function ReturnArray() As Variant
Dim temp(1 To 3, 1 To 3) As Integer
Dim i As Integer
Dim j As Integer
For i = 1 To 3
    For j = 1 To 3
        temp(i, j) = i * i + j
    Next
Next
ReturnArray = temp
End Function

Вот исходя из аргументов формируете нужный массив, возвращаете его на лист.

[Hugo121]

Наваял.

Function summproizv(tabl As Range, nr As Range, kod As Range)
    Dim a(), n(), k(), i&, ii&, t$
    a = tabl.Value: n = nr.Value: k = kod.Value

    With CreateObject("Scripting.Dictionary")
        .comparemode = 1

        For i = 2 To UBound(a, 1)
            For ii = 1 To UBound(a, 2) - 2 Step 3
                t = a(i, ii) & "|" & a(i, ii + 1)
                .Item(t) = .Item(t) + a(i, ii + 2)
            Next ii, i

            ReDim out(1 To nr.Cells.Count, 1 To kod.Cells.Count)
            For i = 1 To UBound(n, 1)
                For ii = 1 To UBound(k, 2)
                    t = n(i, 1) & "|" & k(1, ii)
                    If .exists(t) Then out(i, ii) = .Item(t)
                Next ii, i
        End With

            summproizv = out
    End Function

Выделить на листе диапазон 2х2, в строку формул ввести
=summproizv(A1:L8,N4:N5,O3:P3)
закончить ввод Ctrl+Shift+Enter.
В русском Экселе вероятно вместо "," нужно ";".
Естественно, название UDF можно придумать и пооригинальнее
Код написан под конкретную задачу - т.е. под именно такое расположение данных.

Проверьте сперва на примере, затем на данных побольше ( т.е. не 2х2, а например 100х10)

[staniiislav]

Сообщение от Hugo121

Наваял.

Спасибо сегодня буду пробовать и отпишусь ))))

[staniiislav]

Спасибо БОЛЬШОЕ за помощь!!! Вроде все что хотел получилось!!! ))))