Извините, если название корявое. Есть задача, к которой я даже не могу придумать алгоритм решения, не говоря уже о самом решении Итак, есть даты (строки) и фамилии (столбцы). Необходимо расчищать и внести в ячейку среднее значение каждой фамилии, напротив которой стоит метка в столбце Бригада.
Т.е. в примере на 4 января это Иванов, Сидоров и Васечкин (среднее (447+958+208)/3) Результат 537,66 (выделено красным) разместил возле каждой ячейки.
Огромное заранее спасибо!
Извините, если название корявое. Есть задача, к которой я даже не могу придумать алгоритм решения, не говоря уже о самом решении Итак, есть даты (строки) и фамилии (столбцы). Необходимо расчищать и внести в ячейку среднее значение каждой фамилии, напротив которой стоит метка в столбце Бригада.
Т.е. в примере на 4 января это Иванов, Сидоров и Васечкин (среднее (447+958+208)/3) Результат 537,66 (выделено красным) разместил возле каждой ячейки.
Sub СреднееПоБригаде() 'aequit 08.03.2020 Dim lLastRow As Long, lLastCol As Long Dim i As Long, j As Long Dim n As Long, q As Double lLastCol = Cells(2, Columns.Count).End(xlToLeft).Column lLastRow = Cells(Rows.Count, 1).End(xlUp).Row For i = 3 To lLastRow n = 0 q = 0 For j = 2 To lLastCol If Cells(i, j) = "*" Then n = n + 1 q = q + Cells(i, j + 1) End If Next j For j = 2 To lLastCol If Cells(i, j) = "*" Then Cells(i, j + 2) = WorksheetFunction.Round(q / n, 2) Cells(i, j + 2).Font.Color = vbRed End If Next j Next i End Sub
[/vba]
Проверяйте:
[vba]
Код
Sub СреднееПоБригаде() 'aequit 08.03.2020 Dim lLastRow As Long, lLastCol As Long Dim i As Long, j As Long Dim n As Long, q As Double lLastCol = Cells(2, Columns.Count).End(xlToLeft).Column lLastRow = Cells(Rows.Count, 1).End(xlUp).Row For i = 3 To lLastRow n = 0 q = 0 For j = 2 To lLastCol If Cells(i, j) = "*" Then n = n + 1 q = q + Cells(i, j + 1) End If Next j For j = 2 To lLastCol If Cells(i, j) = "*" Then Cells(i, j + 2) = WorksheetFunction.Round(q / n, 2) Cells(i, j + 2).Font.Color = vbRed End If Next j Next i End Sub