'v3
'На изменения в диапазоне спецификаций реагирует с лагом в одну минуту. Сделано для уменьшения частоты обращения к диапазону.
Function КОЛИЧЕСТВОДЕТАЛЕЙ(изделия As Range, количество_изделий As Range, деталь As String, спецификации As Range) As Double
    Static dicSpec As Object
    Static prevTime As Date
    If dicSpec Is Nothing Or Now > prevTime + TimeSerial(0, 1, 0) Then
        Dim aSpec As Variant
        aSpec = спецификации.Resize(, 3).Value
        Set dicSpec = GetDicSpec(aSpec)
        Set dicSpec = FlatSpec(dicSpec)
        prevTime = Now
    End If
    
    Dim izd As Variant
    izd = GetArrayFromRange(изделия)
    
    Dim kol As Variant
    kol = GetArrayFromRange(количество_изделий)
    
    Dim yi As Long, res As Double
    For yi = 1 To UBound(izd)
        If dicSpec.Exists(izd(yi)) Then
            If dicSpec(izd(yi)).Exists(деталь) Then
                res = res + kol(yi) * dicSpec(izd(yi))(деталь)
            End If
        End If
    Next
    КОЛИЧЕСТВОДЕТАЛЕЙ = res
End Function

Private Function FlatSpec(dicSpec As Object) As Object
    Dim dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    Dim izdelie As Variant, izdSpec As Object
    For Each izdelie In dicSpec.Keys
        Set izdSpec = GetOneIzdSpec(izdelie, dicSpec)
        Set dic(izdelie) = izdSpec
    Next
    Set FlatSpec = dic
End Function

Private Function GetOneIzdSpec(ByVal izdelie As String, dicSpec As Object) As Object
    Dim dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    dic(izdelie) = 1
    
    Dim detal As Variant
    For Each detal In dicSpec(izdelie)
        FillTempDic dic, detal, dicSpec(izdelie)(detal), dicSpec
    Next
    Set GetOneIzdSpec = dic
End Function

Private Sub FillTempDic(dic As Object, ByVal detal As String, ByVal nDetal As Double, dicSpec As Object)
    dic(detal) = dic(detal) + nDetal
    If dicSpec.Exists(detal) Then
        Dim subdetal As Variant
        For Each subdetal In dicSpec(detal)
            FillTempDic dic, subdetal, nDetal * dicSpec(detal)(subdetal), dicSpec
        Next
    End If
End Sub

Private Function GetDicSpec(aSpec As Variant) As Object
    Dim dic As Object
    Set dic = CreateObject("Scripting.Dictionary")

    Dim ya As Long
    For ya = 1 To UBound(aSpec, 1)
        If Not IsEmpty(aSpec(ya, 1)) Then
            If IsNumeric(aSpec(ya, 3)) Then
                If aSpec(ya, 3) > 0 Then
                    If Not dic.Exists(aSpec(ya, 1)) Then
                        Set dic(aSpec(ya, 1)) = CreateObject("Scripting.Dictionary")
                    End If
                    dic(aSpec(ya, 1))(aSpec(ya, 2)) = aSpec(ya, 3)
                End If
            End If
        End If
    Next

    Set GetDicSpec = dic
End Function

Private Function GetArrayFromRange(rr As Range) As Variant
    Dim brr As Variant
    If rr.Cells.CountLarge = 1 Then
        ReDim brr(1 To 1)
        brr(1) = rr.Value
    Else
        Dim arr As Variant, ya As Long
        arr = rr.Value
        ReDim brr(1 To UBound(arr, 1))
        For ya = 1 To UBound(brr)
            brr(ya) = arr(ya, 1)
        Next
    End If
    GetArrayFromRange = brr
End Function