Страницы: 1
RSS
Средневзвешенное значение с уловиями на VBA
 
Здравствуйте. Есть таблица  с результатами матчей игроков NBA. Мне нужно посчитать какое средневзвешенное количество очков  набрали игроки до текущего дня. В  качестве веса берется значение из столбца 'MIN'. Полученные результаты хотелось бы вывести в отдельный столбец, например 'avgPTS'. Каким образом это  можно реализовать с помощью макроса?
 
вы бы на примере в 5-10 строк данных показали (с комментариями) какие средневзвешенные вы хотите посчитать?
(может пример хоть что-то обьяснит)
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Ігор Гончаренко, добавил столбец avgPTS. В нем формула которая выполняет нужный расчет. Хотелось бы на VBA, т.к в полной таблице будет 300-500к строк.
 
Ol272g,
как вариант: https://learn.microsoft.com/ru-ru/office/vba/api/excel.worksheetfunction.sumproduct
Изменено: evgeniygeo - 30.11.2022 12:43:52
 
Код
Sub MuggsyBogues()
    Dim sh As Worksheet
    Set sh = ActiveSheet
    With sh
        Dim yy As Long
        yy = .Cells(.Rows.Count, 1).End(xlUp).Row
        If yy = 1 Then Exit Sub
        
        Dim outputRange As Range
        Dim drr As Variant
        Dim nrr As Variant
        Dim mrr As Variant
        Dim prr As Variant
        Dim res As Variant
        
        drr = .Cells(1, "A").Resize(yy)
        nrr = .Cells(1, "C").Resize(yy)
        mrr = .Cells(1, "G").Resize(yy)
        prr = .Cells(1, "H").Resize(yy)
        Set outputRange = .Cells(1, "J").Resize(yy)
        
        Dim dic As Object
        Set dic = CreateObject("Scripting.Dictionary")
        For yy = 2 To UBound(drr, 1)
            dic.Item(nrr(yy, 1)) = dic.Item(nrr(yy, 1)) + 1
        Next
        
        Dim arr As Variant
        Dim irr As Variant
        Dim player As Variant
        Dim uu As Long
        For Each player In dic.Keys
            uu = dic.Item(player)
            ReDim arr(1 To uu, 1 To 3)
            dic.Item(player) = Array(0, arr)
        Next
        For yy = 2 To UBound(drr, 1)
            player = nrr(yy, 1)
            irr = dic.Item(player)
            uu = irr(0) + 1
            arr = irr(1)
            arr(uu, 1) = drr(yy, 1)
            arr(uu, 2) = mrr(yy, 1)
            arr(uu, 3) = prr(yy, 1)
            dic.Item(player) = Array(uu, arr)
        Next
        
        Dim sum1 As Double
        Dim sum2 As Double
        ReDim res(1 To UBound(drr, 1), 1 To 1)
        For yy = 2 To UBound(drr, 1)
            player = nrr(yy, 1)
            irr = dic.Item(player)(1)
            sum1 = 0
            sum2 = 0
            For uu = 1 To UBound(irr, 1)
                If irr(uu, 1) < drr(yy, 1) Then
                    sum1 = sum1 + irr(uu, 2) * irr(uu, 3)
                    sum2 = sum2 + irr(uu, 2)
                End If
            Next
            If sum2 <> 0 Then
                res(yy, 1) = sum1 / sum2
            End If
        Next
        
        outputRange = res
    End With
End Sub
 
МатросНаЗебре, Спасибо, работает)
Страницы: 1
Наверх