Sub Übersicht()
Dim rngUsed As Range
Dim rngSource As Range
Dim varArr As Variant
Dim srtArr As Variant
Dim x As Integer
Dim strMsg As String
Set rngUsed = ActiveSheet.UsedRange
Set rngUsed = rngUsed.Offset(1, 0).Resize(rngUsed.Rows.Count - 1, rngUsed.Columns.Count)
Set rngSource = rngUsed.Columns(2)
varArr = GetDistinct(rngSource)
srtArr = BubbleSort(varArr)
For x = LBound(srtArr) To UBound(srtArr)
strMsg = strMsg & srtArr(x) & Chr(32) & Format(WorksheetFunction.SumIfs(rngUsed.Columns(4), rngUsed.Columns(2), srtArr(x)), "0.00") & Chr(10)
Next x
Call MsgBox(strMsg, vbOKOnly, "Stundensummen")
End Sub
Private Function GetDistinct(ByVal oTarget As Range) As Variant
Dim varArray As Variant
Dim objMyDic As Object
Dim V As Variant
Set objMyDic = CreateObject("Scripting.Dictionary")
varArray = oTarget
For Each V In varArray
objMyDic(V) = V
Next
GetDistinct = objMyDic.Items()
End Function
Private Function BubbleSort(ByRef strArray As Variant) As Variant()
Dim z As Long, i As Long
Dim strWert As Variant
For z = UBound(strArray) - 1 To LBound(strArray) Step -1
For i = LBound(strArray) To z
If LCase(strArray(i)) > LCase(strArray(i + 1)) Then
strWert = strArray(i)
strArray(i) = strArray(i + 1)
strArray(i + 1) = strWert
End If
Next i
Next z
BubbleSort = strArray
End Function