Создание макроса VBA для excel

Question

У меня есть вот такая таблица в Excel (как пример прикрепляю часть таблицы)

Это таблица с названиями фильмов и оценками от участников, которые смотрели этот фильм. Некоторые фильмы имеют несколько частей, из-за чего я создаю субтаблицы через которые я считаю среднюю оценку с учетом каждой части, а затем только считаю основные оценки. Создавать каждый раз субтаблицы - излишняя работа. Пришла идея написать скрипт, который позволял бы вписывать в ячейку оценки просто строку, а скрипт уже их сам дробил и выдавал мне среднее значение по всем ячейкам, что я выделяю. Написав скрипт столкнулся с проблемой, что система у нас от 0 до 10, если человек ставит 10, то скрипт считает это как 1 и 0, есть конечно вариант это писать в 16-ти системе, чтобы превратить 10 в А, но это не очень удобно, что можно сделать?

То что я додумал:

Function AverageDigitsInRange(rng As Range) As Double
    Dim cell As Range
    Dim i As Long
    Dim ch As String
    Dim total As Double, count As Long

    For Each cell In rng
        If cell.Value <> "-" Then
            For i = 1 To Len(cell.Value)
                ch = Mid(cell.Value, i, 1)
                If IsNumeric(ch) Then
                    total = total + Val(ch)
                    count = count + 1
                End If
            Next i
        End If
    Next cell

    If count > 0 Then
        AverageDigitsInRange = Round(total / count, 1)
    Else
        AverageDigitsInRange = 0
    End If
End Function

Answer 1

Здесь даже VBA не нужно использовать (Microsoft 365):

=AVERAGE(VALUE(TEXTSPLIT(A1;" ")))

Для старого Excel - VBA:

Function CellAverage(s As String) As Double
  Dim length&, sa As Variant, i&
  sa = Split(s)
  length = UBound(sa)
  ReDim r(length) As Double
  For i = 0 To length
    r(i) = CDbl(sa(i))
  Next
  CellAverage = Application.Average(r)
End Function

Формулы для диапазона ячеек, в котором есть как одиночные значения, так и сборные:

=AVERAGE(MAP(A1:B1;LAMBDA(v;IF(ISNUMBER(v);v;AVERAGE(VALUE(TEXTSPLIT(v;" ";;TRUE)))))))
=AVERAGE(DROP(REDUCE(0;A1:B1;LAMBDA(a;v;HSTACK(a;IF(ISNUMBER(v);v;VALUE(TEXTSPLIT(v;" ";;TRUE))))));;1))

Первая формула находит среднее для каждой сборной ячейки, а потом считает среднее всех ячеек, а вторая просто считает среднее всех чисел. А это определяемая пользователем функция (третья формула, среднее всех чисел):

Function AverageDigitsInRange(rng As Range) As Double
  Dim sa As Variant, cell As Range, i&, count&, total#
  For Each cell In rng
    If InStr(cell, " ") = 0 Then
      On Error Goto lblErr1
      total = total + cell
      count = count + 1
lblCont1:
      On Error Goto 0
    Else
      sa = Split(cell)
      For i = 0 To UBound(sa)
        If sa(i) <> "" Then
          On Error Goto lblErr2
          total = total + CDbl(sa(i))
          count = count + 1
lblCont2:
          On Error Goto 0
        End If
      Next i
    End If
  Next cell
  AverageDigitsInRange = IIf(count > 0, Round(total / count, 1), 0)
  Exit Function
lblErr1:
  Resume lblCont1
lblErr2:
  Resume lblCont2
End Function

БЛОГ НА HUSL

Создание макроса VBA для excel

Ответы (1 шт):