Function Auswertung(Zellbereich As Range, ParamArray Filterwerte() As Variant)
Dim z As Long
Dim arr
Dim erg1
Dim erg2
Dim Suchwerte
Dim Ausgabe
Dim Check As Boolean
ReDim Ausgabe(1 To 3, 1 To 1)
Dim x1 As Long, x2 As Long
Suchwerte = Filterwerte
ReDim erg1(WorksheetFunction.Min(Zellbereich.Columns(2)) To WorksheetFunction.Max(Zellbereich.Columns(2)))
ReDim erg2(WorksheetFunction.Min(Zellbereich.Columns(1)) To WorksheetFunction.Max(Zellbereich.Columns(1)))
arr = Intersect(Zellbereich, Zellbereich.Worksheet.UsedRange).Value
For z = 2 To UBound(arr, 1)
If IsEmpty(erg1(arr(z, 2))) Then erg1(arr(z, 2)) = erg2
erg1(arr(z, 2))(arr(z, 1)) = erg1(arr(z, 2))(arr(z, 1)) + arr(z, 3)
Next
Ausgabe(1, 1) = arr(1, 1)
Ausgabe(2, 1) = arr(1, 2)
Ausgabe(3, 1) = arr(1, 3)
For x1 = LBound(erg1) To UBound(erg1)
If VarType(erg1(x1)) <> 0 Then
Check = IsMissing(Filterwerte)
If Not Check Then Check = Not IsError(Application.Match(x1, Suchwerte, 0))
If Check Then
erg2 = erg1(x1)
For x2 = LBound(erg2) To UBound(erg2)
If erg2(x2) <> "" Then
z = UBound(Ausgabe, 2) + 1
ReDim Preserve Ausgabe(1 To 3, 1 To z)
Ausgabe(1, z) = x2
Ausgabe(2, z) = x1
Ausgabe(3, z) = erg2(x2)
End If
Next
z = UBound(Ausgabe, 2) + 1
ReDim Preserve Ausgabe(1 To 3, 1 To z)
Ausgabe(1, z) = ""
Ausgabe(2, z) = ""
Ausgabe(3, z) = WorksheetFunction.Sum(erg1(x1))
End If
End If
Next
Auswertung = WorksheetFunction.Transpose(Ausgabe)
End Function
Sortieren, Filter
