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