Добавление уникальных значений и исключение постоянного значения - оптимизация формул - PullRequest
Новая
       11

Добавление уникальных значений и исключение постоянного значения - оптимизация формул

0 голосов
/ 18 декабря 2018

Мне нужно добавить уникальные значения и убедиться, что я исключаю постоянное значение (например, 10) 

Acct #        Value
9xxx123        50
9xxx123        50
9xxx123        10
9xxx123        15
9xxx234        10
9xxx234        25
9xxx234        25
9xxx234        30

Ответ должен быть: 9xxx123 = 65 и для 9xxx234 = 55

Следующая формула дает мне правильный ответ:

= SUMPRODUCT ((($ A $ 2: $ A $ 9 = E2) * $ B $ 2: $ B $ 9) / (COUNTIFS ($ A $ 2: $ A $ 9, E2, $ B $ 2: $ B $ 9, $ B $ 2: $ B $ 9) + ($ A $ 2: $ A $ 9 <> E2)))

Однако из-за большого объема данных, которые я анализирую, моему компьютеру требуется почти час, чтобы выполнить все вычисления.Любые предложения о том, как оптимизировать эту формулу?

Спасибо!

Лев

1 Ответ

0 голосов
/ 19 декабря 2018

Как насчет пользовательской функции? 

Dim cell As Range
Dim mysum As Long, i As Long, j As Long
Dim checkarr As Variant
Function SUMOMITTINGVALUE(accountrange As Range, accountnumber As Range, omitvalue As Long) As Long

    mysum = 0
    j = 0
    ReDim checkarr(0 To 0)

    For Each cell In accountrange
        If cell.Value = accountnumber And _
           cell.Offset(, 1).Value <> omitvalue Then
            For i = 0 To UBound(checkarr)
                If checkarr(i) = cell.Offset(, 1).Value Then
                    Exit For
                ElseIf i = UBound(checkarr) Then
                    mysum = mysum + cell.Offset(, 1).Value
                    checkarr(j) = cell.Offset(, 1).Value
                    j = j + 1
                    ReDim Preserve checkarr(0 To j)
                End If
            Next i
        End If
    Next cell

    SUMOMITTINGVALUE = mysum
End Function

img1

...