Сообщество Чайников

Вопрос

Мне необходимо, чтобы из колонки I Листа1 данные, соответствующие критерию, суммировались и переносились в определенную ячейку Листа2.
Пример: данные, находящиеся в колонке «I», соответствующие критериям:

* Категория счета — Неоплачиваемый;
* Д (день) — 6
* М (месяц) — 12
суммировались и переносились в ячейку E3
Т.е., чтобы подсчитывалась «реализация по кухне» для «неоплачиваемого счета» за 1 день в этом месяце, и т.д.

Ответ

Вот это — рабочая процедура (а далее — примеры ее вызовов).
[В конце перенесенных строк ставится (через пробел) знак подчеркивания, т.е." _" (см. следующие две строчки)]
Sub InsertSumm(Optional sCat As String, _
Optional bDay As Byte, Optional bMonth As Byte, _
Optional sResCell As String)
'Задаем имена рабочих листов
Const FirstSheet As String = "Отчет"
Const SecondSheet As String = "Отчет за декабрь"
'А это — порядковый номер столбца, откуда берем данные («I»)
Const MyCol As Integer = 9
'Параметры заданы как необязательные, т.е.
'при вызове процедуры без параметров она их запросит
If sCat = "" Then sCat = InputBox("Введите категорию")
If bDay = 0 Then bDay = InputBox("Введите день")
If bMonth = 0 Then bMonth = InputBox("Введите месяц")
If sResCell = "" Then sResCell = _
InputBox("Введите адрес ячейки для вставки суммы")
Sheets(FirstSheet).Activate
Dim lngRow As Long, dblSum As Double
'Цикл по всем строкам столбца, пока не будет пустой
'Начинаем с третьей, т.к. в первых двух — заголовки
For lngRow = 3 To 65535
'Выделяем ячейку
Cells(lngRow, MyCol).Select
'Если она пустая — заканчиваем цикл и вставляем сумму
If ActiveCell.Value = "" Then Exit For
'Проверяем "соседей" ячейки на условия
'(Ячейки со смещением относительно исходной
'в 7, 5 и 4 столбца)
If ActiveCell.Offset(0, -7).Value = sCat And _
Day(ActiveCell.Offset(0, -5).Value) = bDay And _
Month(ActiveCell.Offset(0, -4).Value) = bMonth Then
dblSum = dblSum + ActiveCell.Value
End If
Next lngRow
'Переходим на нужный лист
Sheets(SecondSheet).Activate
'Выделяем нужную ячейку
Range(sResCell).Select
'Вставляем сумму
ActiveCell.Value = dblSum
End Sub

'Вызов процедуры с заданными параметрами:
'Категория — Клубный, День — 6, Месяц — 12,
'Результирующая ячейка — B3
Sub DoInsert()
InsertSumm "Клубный", 6, 12, "B3"
End Sub
'Вызов процедуры без параметров
'(Параметры будут запрашиваться у пользователя)
Sub PromptInsert()
InsertSumm
End Sub

Alex