Hallo zusammen, ich habe mir mit Hilfe von Bing eine modifizierte Teilergebnisformel gebaut. Diese funktioniert super nur in manchen fällen addiert Sie auch wenn die Bedingung nicht erfüllt ist. keine Ahnung woran es liegt. ich glaube die "CountIfs" Prüfung funktioniert nicht richtig. Hier der Code und zwei beispielspalten wo das Problem auftritt und eine Beispieldatei:

https://www.herber.de/bbs/user/164188.xlsb

Function CustomSubtotal109(rng As Range, CriteriaRange As Range, ByVal Criteria As Variant) As Variant
Dim cell As Range
Dim subtotalValue As Double
Dim condition As Boolean
Dim c As Variant ' Define variable c as Variant

' Initialize the subtotal value
subtotalValue = 0

' Iterate through each cell in the range
For Each cell In rng
' Check if the cell meets the criteria and is not a calculated CustomSubtotal109 cell
condition = False ' Reset the condition for each cell

If cell.HasFormula Then
' Check if the cell formula references CustomSubtotal109
If InStr(1, cell.Formula, "CustomSubtotal109", vbTextCompare) > 0 Then
' Ignore calculated CustomSubtotal109 cell
condition = False
GoTo NextCell
End If
End If

If IsArray(Criteria) Then
' Criteria is an array of values
For Each c In Criteria
If Application.WorksheetFunction.CountIfs(CriteriaRange, c, rng, cell) > 0 Then
condition = True
Exit For ' Exit the loop if a match is found
End If
Next c
Else
' Criteria is a single value
If Application.WorksheetFunction.CountIfs(CriteriaRange, Criteria, rng, cell) > 0 Then
condition = True
End If
End If

If condition Then
' Add the cell value to the subtotal
subtotalValue = subtotalValue + cell.Value
End If

NextCell:
Next cell

CustomSubtotal109 = subtotalValue
End Function