|
Eine unsortierte Excel-Tabelle? - ggf. so!
Sub Übersicht()
'Testumgebung
'aktive Tabelle (Excel) - Version 2013
'Überschriften Zeile 1 / Spalte A, B = Projekt, C, D = Stunden
Dim rngUsed As Range 'Datenbereich
Dim rngSource As Range 'Projektspalte
Dim varArr As Variant 'Datenfeld Projekte
Dim srtArr As Variant 'Datenfeld Projekte sortiert
Dim x As Integer 'Zähler
Dim strMsg As String 'Ausgabevariante
'Datenbereich
Set rngUsed = ActiveSheet.UsedRange
'Überschrift weg
Set rngUsed = rngUsed.Offset(1, 0).Resize(rngUsed.Rows.Count - 1, rngUsed.Columns.Count)
'Projekte in Spalte 2 ohne Duplikate in Datenfeld
Set rngSource = rngUsed.Columns(2)
varArr = GetDistinct(rngSource)
'und sortieren
srtArr = BubbleSort(varArr)
'Ausgabe nach Geschmack oder Weiterverwendung
For x = LBound(srtArr) To UBound(srtArr)
'Debug.Print srtArr(x), WorksheetFunction.SumIfs(rngUsed.Columns(4), rngUsed.Columns(2), srtArr(x))
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
'posted by Craig Hatmaker
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()
'eine von zig-Varianten aus dem Web
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
|