AW: Es sollte VBA sein
14.10.2011 23:07:48
CitizenX
Hi Jean,
Option Explicit
Sub sumUnique1()
'Listet die Unikate aus Spalte 1 auf .
'Gibt Die Bezeichnung dieser aus.
'Summiert deren Stückzahlen
'Ausgabe erfolgt im Bereich E:G
Dim i&, lngLast&
Dim oDict As Object, oDict1 As Object
lngLast = Cells(Rows.Count, 1).End(xlUp).Row
Set oDict = CreateObject("scripting.dictionary")
Set oDict1 = CreateObject("scripting.dictionary")
For i = 2 To lngLast
oDict(Cells(i, 1).Value) = oDict(Cells(i, 1).Value) + Cells(i, 3).Value
oDict1(Cells(i, 1).Value) = Cells(i, 2).Value
Next
Cells(2, 5).Resize(lngLast, 3).ClearContents
Cells(2, 5).Resize(oDict.Count, 1) = Application.Transpose(oDict.Keys)
Cells(2, 6).Resize(oDict.Count, 1) = Application.Transpose(oDict1.items)
Cells(2, 7).Resize(oDict.Count, 1) = Application.Transpose(oDict.items)
Set oDict = Nothing
Set oDict1 = Nothing
End Sub
Sub sumUnique2()
'Listet die Unikate aus Spalte 1 auf .
'Summiert deren Stückzahlen
'Ausgabe erfolgt im Bereich E:F
Dim i&, lngLast&
Dim oDict As Object
lngLast = Cells(Rows.Count, 1).End(xlUp).Row
Set oDict = CreateObject("scripting.dictionary")
For i = 2 To lngLast
oDict(Cells(i, 1).Value) = oDict(Cells(i, 1).Value) + Cells(i, 3).Value
Next
Cells(2, 5).Resize(lngLast, 2).ClearContents
Cells(2, 5).Resize(oDict.Count, 1) = Application.Transpose(oDict.Keys)
Cells(2, 6).Resize(oDict.Count, 1) = Application.Transpose(oDict.items)
Set oDict = Nothing
End Sub
Grüße
Steffen