Berechen

Sub rechnen()
Dim objDic As Object
Dim arr As Variant
Dim lZeile As Long
Dim dValue As Double
Dim lZL As Long
Dim lZA As Long
Dim lZWa As Long
Dim x As Integer
Set wksA = ThisWorkbook.Worksheets("Art")
Set wksR = ThisWorkbook.Worksheets("RE")
lZA = wksA.Cells(Rows.Count, 1).End(xlUp).Row
wksR.Range(wksR.Cells(2, 1), wksR.Cells(3, 4)).ClearContents
'Bezeichnung
Set objDic = CreateObject("Scripting.Dictionary")
arr = wksA.Range("E2:E" & lZA)                                                   ' _
FEHLERMELDUNG"
For x = LBound(arr) To UBound(arr)
objDic(arr(x, 1)) = 0
Next
wksR.Range("A2").Resize(objDic.Count) = WorksheetFunction.Transpose(objDic.keys) ' _
Ausgeben
For lZeile = 2 To wksR.Cells(Rows.Count, 1).End(xlUp).Row
wksR.Cells(lZeile, 2) = Application.WorksheetFunction.SumIf(wksA.Range("E2:E" & lZA) _
, wksR.Cells(lZeile, 1), wksA.Range("H2:H" & lZA)) 'Anzahl
wksR.Cells(lZeile, 3) = Application.WorksheetFunction.SumIf(wksA.Range("E2:E" & lZA) _
, wksR.Cells(lZeile, 1), wksA.Range("N2:N" & lZA))
wksR.Cells(lZeile, 4) = Application.WorksheetFunction.SumIf(wksA.Range("E2:E" & lZA) _
, wksR.Cells(lZeile, 1), wksA.Range("S2:S" & lZA))
Next
Set wksA = Nothing
Set wksR = Nothing
End Sub