Здравствуйте помогите пожалуйста сутки уже ковыряюсь не могу решить задачку для вычисления среднего значения, суть такова в столбце А ищет похожий текст (в примере "Итогона ПК") и в этой строчке уже в столбце "С" и в столбце "Е" вычисляет среднее значения на 100м в среди данных в этом диапозоне . Всем спасибо за помощь
Код
Sub Среднее_по_искомому_тексту()
Dim strFistCell As String
Dim strLastCell As String
Dim strFormula As String
Dim c As Range
Dim SrchRng
lr = Cells(Rows.Count, 1).End(xlUp).Row
Set c = Range("A:A").Find("Итого на ПК:", LookIn:=xlValues)
For i = 1 To lr
If Cells(i, 1).Value Like c Then
Range("C" & i).Select
Range("E" & i).Select
Selection.Row = 1 Then Exit Sub
strFistCell = ActiveCell.Offset(-1, 0).End(xlUp).Address
strLastCell = ActiveCell.Offset(-1, 0).Address
strFormula = "=AVERAGE(" & strFistCell & ":" & strLastCell & ")"
ActiveCell.Formula = strFormula
End If
Next i
End Sub
aset224, здравствуйте Описание не очень - сделал, как понял. Файл слишком большой для примера - уменьшил (на первый раз делаю за вас )
Выделить область данных, в которой нужны только крайние столбцы (первый - признак, последний - для вычисления и вставки) и нажать кнопку. В примере область данных: «A2:C26»
Код
Option Explicit
Sub Test()
Dim arr, s#, n&, r&
Const txtCrit$ = "*Итого на ПК:*"
arr = Selection.Value2
If Not IsArray(arr) Then Exit Sub
For r = 1 To UBound(arr, 1)
If arr(r, 1) Like txtCrit Then
arr(r, UBound(arr, 2)) = --Format$(s / n, "0.00")
n = 0
s = 0
Else
If IsNumeric(arr(r, UBound(arr, 2))) Then
n = n + 1
s = s + arr(r, UBound(arr, 2))
End If
End If
Next r
Selection.Value2 = arr
End Sub
Если угадал, то название темы: Вычисление макросом среднего арифметического в промежуточных итогах таблицы
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
aset224, пожалуйста Поправил диапазон данных в инструкции, вынес инструкцию в название спойлера
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Jack Famous,спасибо огромное, работает) но есть один нюанс я заполняю пустые прочерком "-", он их не учитывает в вычислении среднего значения, но если за ПК нет числовых данных вылетает ошибка. P.S. с меня кофе. скинь мне свой киви или yandex money
aset224: с меня кофе. скинь мне свой киви или yandex money
давайте останемся "на вы" всё-таки. Заменил цитату в подписи на номер кошелька
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
aset224, за кофе спасибо) Проверяйте: теперь он любые НЕчисловые данные в проставляемом столбце считает нолями. Excel в таком случае исключил бы такие поля из расчёта (см. скрин) Также добавлены проверки и итоговое сообщение с временем выполнения в заголовке
Код
Код
Option Explicit
Sub Test()
Dim rng As Range, arr, iVal#, s#, n&, r&, t!
t = Timer: Set rng = Selection
If rng.Areas.Count <> 1 Then MsgBox "Не более ОДНОЙ области выделения!", vbExclamation, "ОШИБКА ВЫДЕЛЕНИЯ": Exit Sub
If rng.Rows.Count < 3 Then MsgBox "Не менее ТРЁХ строк!", vbExclamation, "ОШИБКА ВЫДЕЛЕНИЯ": Exit Sub
If rng.Columns.Count < 2 Then MsgBox "Не менее ДВУХ столбцов!", vbExclamation, "ОШИБКА ВЫДЕЛЕНИЯ": Exit Sub
arr = rng.Value2
For r = 1 To UBound(arr, 1)
If arr(r, 1) Like "*Итого*" Then
If arr(r, 1) Like "*ПК:*" Then
arr(r, UBound(arr, 2)) = --Format$(s / n, "0.00")
n = 0: s = 0
End If
Else
If IsNumeric(arr(r, UBound(arr, 2))) Then iVal = --arr(r, UBound(arr, 2)) Else iVal = 0
n = n + 1: s = s + iVal
End If
Next r
rng.Value2 = arr
MsgBox "Макрос успешно обработал строк данных: " & UBound(arr, 1), vbInformation, Format$(Timer - t, "0.00 сек")
End Sub
Изменено: Jack Famous - 10.04.2020 13:21:13(Обновил скрин)
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Jack Famous: теперь он любые НЕчисловые данные в проставляемом столбце считает нолями. Excel в таком случае исключил бы такие поля из расчёта
то есть "ошибка" была в том, что при вычислении среднего арифметического полученную сумму он делит на количество ячеек с учётом прочерков
Код с комментариями
Код
Option Explicit ' проверка назначения всех переменных (своими словами)
Option Private Module ' макросы из модуля не отображаются в окне макросов (своими словами)
'===========================================================================================
Sub ПроставитьСрАрифмВПоследнемСтолбцеВыделения()
Dim rng As Range, arr, iVal#, s#, n&, r&, t! ' тут назначаются переменные с их типами
t = Timer ' запоминаем текущее время в переменную
Set rng = Selection ' назначаем переменной диапазона выделенную (мышкой на активном листе на момент нажатия кнопки) область
' проверки на области выделения, количество строк и столбцов
If rng.Areas.Count <> 1 Then MsgBox "Не более ОДНОЙ области выделения!", vbExclamation, "ОШИБКА ВЫДЕЛЕНИЯ": Exit Sub
If rng.Rows.Count < 3 Then MsgBox "Не менее ТРЁХ строк!", vbExclamation, "ОШИБКА ВЫДЕЛЕНИЯ": Exit Sub
If rng.Columns.Count < 2 Then MsgBox "Не менее ДВУХ столбцов!", vbExclamation, "ОШИБКА ВЫДЕЛЕНИЯ": Exit Sub
arr = rng.Value2 ' забираем диапазон в массив (для скорости)
For r = 1 To UBound(arr, 1) ' запускаем цикл по всем строкам масива (с первой "r = 1" до сколько их всего "UBound(arr, 1)")
If arr(r, 1) Like "*Итого*" Then ' если в очередной (№ r) ячейке первого столбца из выделенной области содержится "Итого", то…
If arr(r, 1) Like "*ПК*" Then ' если также там содержится "ПК", то это строка, в которую нам надо проставить ср.ариф.…
arr(r, UBound(arr, 2)) = --Format$(s / n, "0.00") ' вычисляем ср. арифм. с округлением до 2ух знаков и записываем итог в массив (текущая ячейка последнего столбца выделенной области)
n = 0: s = 0 ' обнуляем переменные количества ячеек и суммы
End If
Else ' если в очередной (№ r) ячейке первого столбца из выделенной области НЕ содержатся "Итого", то это ячейка с данными …
If IsNumeric(arr(r, UBound(arr, 2))) Then ' если в ячейке данных содержится число, то …
n = n + 1 ' увеличиваем счётчик ячеек итога
s = s + arr(r, UBound(arr, 2)) ' наращиваем сумму ячеек итога
End If
End If
Next r
rng.Value2 = arr ' выгружаем массив обратно на лист, откуда взяли (в принципе, достаточно только один столбец выгружать, но так будет чуть длиннее код)
MsgBox "Макрос успешно обработал строк данных: " & UBound(arr, 1), vbInformation, Format$(Timer - t, "0.00 сек") ' выводим сообщение об успехе с подсчётом времени работы
End Sub
'===========================================================================================
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
aset224, без проблем - обращайтесь за кофе благодарю
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Исправлена ошибка деления на ноль (когда для итога не было данных)
Код с комментариями
Код
Option Explicit ' проверка назначения всех переменных (своими словами)
Option Private Module ' макросы из модуля не отображаются в окне макросов (своими словами)
'===========================================================================================
Sub ПроставитьСрАрифмВПоследнемСтолбцеВыделения()
Dim rng As Range, arr, iVal#, s#, n&, r&, t! ' тут назначаются переменные с их типами
t = Timer ' запоминаем текущее время в переменную
Set rng = Selection ' назначаем переменной диапазона выделенную (мышкой на активном листе на момент нажатия кнопки) область
' проверки на области выделения, количество строк и столбцов
If rng.Areas.Count <> 1 Then MsgBox "Не более ОДНОЙ области выделения!", vbExclamation, "ОШИБКА ВЫДЕЛЕНИЯ": Exit Sub
If rng.Rows.Count < 3 Then MsgBox "Не менее ТРЁХ строк!", vbExclamation, "ОШИБКА ВЫДЕЛЕНИЯ": Exit Sub
If rng.Columns.Count < 2 Then MsgBox "Не менее ДВУХ столбцов!", vbExclamation, "ОШИБКА ВЫДЕЛЕНИЯ": Exit Sub
arr = rng.Value2 ' забираем диапазон в массив (для скорости)
For r = 1 To UBound(arr, 1) ' запускаем цикл по всем строкам масива (с первой "r = 1" до сколько их всего "UBound(arr, 1)")
If arr(r, 1) Like "*Итого*" Then ' если в очередной (№ r) ячейке первого столбца из выделенной области содержится "Итого", то…
If arr(r, 1) Like "*ПК*" Then ' если также там содержится "ПК", то это строка, в которую нам надо проставить ср.ариф.…
If n = 0 Then ' если чисел в столбце проставления не было (счётчик равен нолю), то …
arr(r, UBound(arr, 2)) = 0 ' записываем в результат ноль, чтобы избежать ошибки деления на ноль
Else ' в противном случае (если счётчик ненулевой) …
arr(r, UBound(arr, 2)) = --Format$(s / n, "0.00") ' вычисляем ср. арифм. с округлением до 2ух знаков и записываем итог в массив (текущая ячейка последнего столбца выделенной области)
n = 0: s = 0 ' обнуляем переменные количества ячеек и суммы
End If
End If
Else ' если в очередной (№ r) ячейке первого столбца из выделенной области НЕ содержатся "Итого", то это ячейка с данными …
If IsNumeric(arr(r, UBound(arr, 2))) Then ' если в ячейке данных содержится число, то …
n = n + 1 ' увеличиваем счётчик ячеек итога
s = s + arr(r, UBound(arr, 2)) ' наращиваем сумму ячеек итога
End If
End If
Next r
rng.Value2 = arr ' выгружаем массив обратно на лист, откуда взяли (в принципе, достаточно только один столбец выгружать, но так будет чуть длиннее код)
MsgBox "Макрос успешно обработал строк данных: " & UBound(arr, 1), vbInformation, Format$(Timer - t, "0.00 сек") ' выводим сообщение об успехе с подсчётом времени работы
End Sub
'===========================================================================================
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄