Многокритериальный родительско-дочерний SumProduct VBA

Question

Пожалуйста, помогите.

Я пытаюсь создать определяемую пользователем функцию, которая будет использовать массив в качестве нескольких критериев (Родословная) для проверки соответствующих родителей (Родитель), а затем суммировать их соответствующие диапазоны (Sumrange) .

Мне удалось создать код, который будет проверять, находится ли родитель в диапазоне родословных, который затем вернет результат 1 или 0. Это не вернет истинные значения, если пробелы проверяют пробелы. Я собираюсь создать массив с этими 1 и 0, чтобы затем SumProduct его с помощью моего Sumrange. Моя проблема в том, что я не могу создать массив из этих 1 и 0 и SumProduct их с помощью Sumrange без возврата значения #.

Этот ниже код не включает часть SumProduct, а просто возвращает 1 или 0 на основе по критериям.

Function ProdIfs(Parent As Range, Pedigree As Range, Sumrange As Range) As Long
Application.Volatile

Dim i As Variant
Dim j As Variant
Dim result As Integer
    result = 0

For Each i In Parent
For Each j In Pedigree
    If i.Value = "" Or j.Value = "" Then
        result = result
        ElseIf i.Value = j.Value Then
        result = 1: GoTo NextIteration
    End If
Next j
NextIteration:
Next i

ProdIf = result
        
End Function

Спасибо за помощь.

Answer 1

Спасибо Super Symmetry за то, что удалось добиться этого на 99%.

Так как исходный код возвращал 1 или 0, я изменил код, чтобы предоставить sumproduct.

Также я Я сделал PedigreeRange l oop через столбцы вместо строк, чтобы соответствовать способу моих данных Pedigree.

Function ProdIfs(Parent As Range, Pedigree As Range, Sumrange As Range) As Variant
    Application.Volatile
    
    Dim i As Long
    Dim j As Long
    Dim result() As Variant
    ReDim result(1, 1 To Parent.Rows.Count)
    Dim x As Long
    
    For i = 1 To Parent.Rows.Count
        x = 0
        result(1, i) = x
        For j = 1 To Pedigree.Columns.Count
            If Parent.Cells(i, 1).Value <> "" And Pedigree.Cells(1, j) <> "" And Parent.Cells(i, 1) = Pedigree.Cells(1, j) Then
                x = 1
                Exit For
            End If
        Next j
        result(1, i) = x * Sumrange(i, 1).Value
    Next i
    
    ProdIfs = WorksheetFunction.Sum(result)
            
End Function

Еще раз спасибо. Если есть какие-либо улучшения, которые можно внести в это, сообщите мне.

Answer 2

Ответ изменен после комментариев

Если вы хотите вернуть массив, вам действительно нужно создать и заполнить массив в своей функции и убедиться, что тип возвращаемого значения - Variant.

Попробуйте это

Function ProdIfs(Parent As Range, Pedigree As Range, Sumrange As Range) As Variant
    Application.Volatile
    
    Dim i As Long
    Dim j As Long
    Dim result() As Integer ' The return value must be an array
    ReDim result(1 To Parent.Rows.Count, 1 To 1) ' Assuming Parent is 1 column
    
    For i = 1 To Parent.Rows.Count
        result(i, 1) = 0 ' set to 0 by default but always good to do it explicitly
        For j = 1 To Pedigree.Rows.Count
            If Parent.Cells(i, 1).Value <> "" And Parent.Cells(i, 1) = Pedigree.Cells(j, 1) Then
                result(i, 1) = 1
                Exit For
            End If
        Next j
    Next i
    
    ProdIfs = result
            
End Function

Изменить: следуя вашему ответу

• Вам просто нужно сохранить текущую сумму.
• Чтобы создать свой код работать быстрее, вы должны читать значения этих диапазонов и обрабатывать их в памяти. (Это намного быстрее, чем запрашивать в Excel значения в ячейках).
• Возвращаемое значение должно быть Double
• Это похоже на SumIfs раннее, чем ProdIfs

Function ProdIfs(Parent As Range, Pedigree As Range, Sumrange As Range) As Double
    Application.Volatile
    
    Dim i As Long
    Dim v As Variant
    Dim vParent As Variant:     vParent = Parent.Value
    Dim vPedigree As Variant:   vPedigree = Pedigree.Value
    Dim vSumRange As Variant:   vSumRange = Sumrange.Value
    
    ProdIfs = 0
    For i = 1 To UBound(vParent, 1)
        For Each v In vPedigree
            If len(v) > 0 And v = vParent(i, 1) Then
                ProdIfs = ProdIfs + vSumRange(i, 1)
                Exit For
            End If
        Next v
    Next i
            
End Function