Option Explicit

Public daten As Collection
Public import As Range
Public auswertung As Range
Public pos_aus

Sub teilsummen()

Set import = Sheets("Import").Range("A1")
Set auswertung = Sheets("Auswertung").Range("A1")
Set daten = New Collection

pos_aus = 1

auslesen einlesen

Set import = Nothing
Set auswertung = Nothing
Set daten = Nothing

End Sub


Function einlesen()

Dim einZeil As Long
Dim aktzeil As String

einZeil = 1
aktzeil = import.Cells(einZeil, 1).Value

While aktzeil <> ""

On Error Resume Next

aktzeil = daten(aktzeil)
If Err.Number <> 0 Then
   daten.Add aktzeil, aktzeil
End If
einZeil = einZeil + 1
aktzeil = import.Cells(einZeil, 1).Value
Wend
einlesen = einZeil - 1
End Function

Function auslesen(elemente)
Dim head As Long
Dim data As Long
Dim akt As Double
Dim sumPos As Double
Dim sumGes As Double

For head = 1 To daten.Count
    sumPos = 0
    For data = 1 To elemente
        
        If CStr(import.Cells(data, 1).Value) = CStr(daten(head)) Then
        akt = import.Cells(data, 2).Value
        With auswertung
        .Cells(pos_aus, 1).Value = "'" & CStr(daten(head))
        .Cells(pos_aus, 2).Value = akt
        sumPos = sumPos + CDbl(akt)
        End With
        pos_aus = pos_aus + 1
        End If
    Next

With auswertung
With .Cells(pos_aus, 1)
    .Value = "'" & CStr(daten(head))
    .Font.Bold = True
    .Borders(xlEdgeTop).LineStyle = xlContinuous
End With
With .Cells(pos_aus, 2)
    .Value = sumPos
    .Font.Bold = True
    .Borders(xlEdgeTop).LineStyle = xlContinuous
End With


sumGes = sumGes + sumPos
sumPos = 0
pos_aus = pos_aus + 2
End With


Next

pos_aus = pos_aus + 1

With auswertung.Cells(pos_aus, 1)
    .Value = "Gesamt"
    .Font.Bold = True
    .Borders(xlTop).LineStyle = xlContinuous
    .Borders(xlEdgeBottom).LineStyle = xlDouble
End With

With auswertung.Cells(pos_aus, 2)
    .Value = sumGes
    .Font.Bold = True
    .Borders(xlTop).LineStyle = xlContinuous
    .Borders(xlEdgeBottom).LineStyle = xlDouble
End With

End Function