Zwischensummen

Question

Hallo,

ich habe in Spalte "A" eine sortierte Liste mit verschiedenen Produktnamen, die sich aber beliebig oft wiederholen. In Spalte "B" stehen dazugehörende Mengenangaben.
Ich möchte die Liste "verkürzen" und die Mengenangaben je Produktnamen aufsummieren und dann nur noch die errechneten Zwischensummen anzeigen.
Hat jemand einen Tipp?
Gruß A.

Answer 1

Hallo Andreas,

schau dir mal die folgenden Links zur Pivot-Tabelle an:
Link 1
Link 2

Oder hier eine Erklärung im Schnelldurchgang ;-).
[list]- Cursor in deine Tabelle setzen
- im Menüband Einfügen - PivotTable - PivotTable auswählen
- bei "Tabelle oder Bereich auswählen" Spalten A und B deiner Datentabelle auswählen
- Pivot-Tablebereich in ein neues Datenblatt einfügen
- dann mit OK bestätigten
- nun auf dem neuen Blatt im rechten Feld in der PivotTable-Feldliste die Felder Produktname und Mengenangabe (oder wie die Spalten A und B auch immer heißen) auswählen[/list]
Fertig.
Im PivotTable-Feld kannst du mit Klick auf "Produktname" und dort bei Feldeinstellungen die Überschrift anpassen, die in der Pivot-Tabelle angezeigt wird. Ebenso beim Feld "Summe von .."

Gruß

M.O.

Answer 2

Hallo M.O.,
danke für deinen guten Tipp! Ich brauche diese Prozedur allerdings innerhalb eines Codes. Hast du da auch noch eine Idee?
Gruß A.

Answer 3

Hallo Andreas,

dann würde ich das über Summewenn lösen.
Hier ein kleiner Beispielcode:

Sub summewenn()

Dim sngSumme As Single
Dim rngSuch As Range
Dim rngSum As Range
Dim strPName As String

Set rngSuch = ActiveSheet.Range("A1:A10") 'Bereich in dem Produktname stehen
Set rngSum = ActiveSheet.Range("B1:B10") 'Bereich der summiert werden soll
strPName = "Produkt1" 'Name des Produkts, für das Summe gebildet werden soll

sngSumme = Application.WorksheetFunction.SumIf(rngSuch, strPName, rngSum)

MsgBox "Von dem Produkt " & strPName & " sind noch " & sngSumme & " Stück vorhanden"

End Sub

Gruß

M.O.

Answer 4

Hallo Andreas ^^

Meinst du es so ?

Gruss Nighty

Spalte A Artikel die auch mehrfach vorkommen
Spalte B Wert

Wert wird von mehrfachvorkommenden Artikel addiert

Ausgabe
Spalte C

Sub Addieren()
Dim LZeile As Long, Puffer As Long, ArrIndex As Long
Dim DatenArr As Variant, ErgArr As Variant
LZeile = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1
DatenArr = Range("A2:B" & LZeile)
Range("C2:C" & Rows.Count).Clear
ErgArr = Range("C2:C" & LZeile)
For ArrIndex = 1 To LZeile - 2
If DatenArr(ArrIndex, 1) <> "" Then
Puffer = Puffer + DatenArr(ArrIndex, 2)
If DatenArr(ArrIndex, 1) <> DatenArr(ArrIndex + 1, 1) Then
ErgArr(ArrIndex, 1) = Puffer
Puffer = 0
End If
End If
Next ArrIndex
Range("C2:C" & LZeile) = ErgArr
End Sub

Answer 5

Hallo Andreas ^^

Addierung und löschen!
Sortierung immer vorrausgesetzt

Gruss Nighty

Sub Addieren()
Dim LZeile As Long, Puffer As Long, ArrIndex As Long
Dim DatenArr As Variant, ErgArr As Variant
LZeile = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1
DatenArr = Range("A2:B" & LZeile)
Range("C2:C" & Rows.Count).Clear
ErgArr = Range("C2:C" & LZeile)
For ArrIndex = 1 To LZeile - 2
If DatenArr(ArrIndex, 1) <> "" Then
Puffer = Puffer + DatenArr(ArrIndex, 2)
If DatenArr(ArrIndex, 1) <> DatenArr(ArrIndex + 1, 1) Then
ErgArr(ArrIndex, 1) = Puffer
Puffer = 0
End If
End If
Next ArrIndex
Range("C2:C" & LZeile) = ErgArr
ActiveSheet.Range("A1:C1").AutoFilter
ActiveSheet.Range("C1").AutoFilter Field:=3, Criteria1:="=" & " "
ActiveSheet.Rows("2:" & LZeile).Delete Shift:=xlUp
ActiveSheet.Cells(1, 3).AutoFilter
End Sub

Answer 6

Hallo,

vielen Dank an euch für eure Tipps! nighty Code hat mein Problem genau erfaßt und gelöst!! Danke.
Gruß A.