AW: Daten aus gleichen Werten zusammenführen
12.10.2020 14:10:35
Nepumuk
Hallo Tobias,
per VBA so:
Option Explicit
Public Sub Summe()
Dim avntValues As Variant, avntSumm() As Variant
Dim ialngIndex As Variant, ialngRow As Long, ialngTemp As Long
Dim objDicitionary As Object
Set objDicitionary = CreateObject(Class:="Scripting.Dictionary")
With Worksheets("Tabelle1")
avntValues = .Range(.Cells(2, 1), .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, 7)).Value
End With
With objDicitionary
For ialngRow = LBound(avntValues, 1) To UBound(avntValues, 1)
If Not .Exists(Key:=avntValues(ialngRow, 1)) Then
Call .Add(Key:=avntValues(ialngRow, 1), Item:=ialngIndex)
Redim Preserve avntSumm(6, ialngIndex)
avntSumm(0, ialngIndex) = IIf(IsEmpty(avntValues(ialngRow, 1)), Empty, avntValues(ialngRow, 1))
avntSumm(1, ialngIndex) = IIf(IsEmpty(avntValues(ialngRow, 2)), Empty, avntValues(ialngRow, 2))
avntSumm(2, ialngIndex) = IIf(IsEmpty(avntValues(ialngRow, 3)), Empty, avntValues(ialngRow, 3))
avntSumm(3, ialngIndex) = IIf(IsEmpty(avntValues(ialngRow, 4)), Empty, avntValues(ialngRow, 4))
avntSumm(4, ialngIndex) = IIf(IsEmpty(avntValues(ialngRow, 5)), Empty, avntValues(ialngRow, 5))
avntSumm(5, ialngIndex) = IIf(IsEmpty(avntValues(ialngRow, 6)), Empty, avntValues(ialngRow, 6))
avntSumm(6, ialngIndex) = IIf(IsEmpty(avntValues(ialngRow, 7)), Empty, avntValues(ialngRow, 7))
ialngIndex = ialngIndex + 1
Else
ialngTemp = .Item(Key:=avntValues(ialngRow, 1))
avntSumm(1, ialngTemp) = IIf(Not IsEmpty(avntValues(ialngRow, 2)), _
avntSumm(1, ialngTemp) + avntValues(ialngRow, 2), avntSumm(1, ialngTemp))
avntSumm(2, ialngTemp) = IIf(Not IsEmpty(avntValues(ialngRow, 3)), _
avntSumm(2, ialngTemp) + avntValues(ialngRow, 3), avntSumm(2, ialngTemp))
avntSumm(3, ialngTemp) = IIf(Not IsEmpty(avntValues(ialngRow, 4)), _
avntSumm(3, ialngTemp) + avntValues(ialngRow, 4), avntSumm(3, ialngTemp))
avntSumm(4, ialngTemp) = IIf(Not IsEmpty(avntValues(ialngRow, 5)), _
avntSumm(4, ialngTemp) + avntValues(ialngRow, 5), avntSumm(4, ialngTemp))
avntSumm(5, ialngTemp) = IIf(Not IsEmpty(avntValues(ialngRow, 6)), _
avntSumm(5, ialngTemp) + avntValues(ialngRow, 6), avntSumm(5, ialngTemp))
avntSumm(6, ialngTemp) = IIf(Not IsEmpty(avntValues(ialngRow, 7)), _
avntSumm(6, ialngTemp) + avntValues(ialngRow, 7), avntSumm(6, ialngTemp))
End If
Next
End With
Set objDicitionary = Nothing
Worksheets("Tabelle1").Cells(2, 9).Resize(ialngIndex, 7) = Application.Transpose(avntSumm)
End Sub
Gruß
Nepumuk