Abfrage in Spalte, aufsummieren nachfolgender Wert

Hallo Zusammen,
ich habe foglendes Problem und wäre euch wirklich sehr dankbar wenn ihr mir weiterhelfen könntet.Seit ein paar Wochen beschäftige ich mich nun mit VBA hatte aber bisher mit Schleifen noch nicht zu tun .
Ich benötige eine Abfrage der Spalte 5 im ActiveSheet.
Die Abfrage soll in der Zelle E3 starten und nach unten fortlaufend die Zellen überprüfen, ob diese leer sind. Trifft die Abfrage auf eine leere Zelle, so sollen alle nachfolgenden Werte , bis zur "nächsten Leerzellee" in der zuerst ermittelten Leerzelle summiert werden.
Anschließend soll die Abfrage in der zuvor "nächsten Leerzelle" genannten Zelle wieder nach dem _
selben Prinzip starten und alle nachfolgenden Werte in dieser Zelle summieren. Wenn die Abfrage _
beendet ist, sollen alle Leerzeilen gelöscht werden, wofür ich bereits eine Codezeile habe

 _
_
_
_
lR = Cells(Rows.Count, 1).End(xlUp).Row
For i = lR To 1 Step -1
If WorksheetFunction.CountA(Cells(i, 1), Cells(i, 5)) = 0 Then Rows(i).Delete
Next i

Ich versuche den Datenaufbau kurz aufzuzeigen :



Spalte A       Spalte E
Materialtext    Menge
Stk
Artikel 1       1
Artikel 2       5
Artikel 5       17
Artikel 4       36
Artikel 5
2
3
Artikel 6
112
136
148
Artikel 9
12
13
Das Ganze soll dann nach Ausführen des Makros so aussehen
Artikel 1       1
Artikel 2       5
Artikel 5       17
Artikel 4       36
Artikel 5       5
Artikel 6       396
Artikel 9       25
    

Ich hoffe ich konnte es verständlich beschreiben und freue mich auf eure Vorschläge

Mit freundlichem Gruß

andthen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

lR = Cells(Rows.Count, 1).End(xlUp).Row Z1=3 Z2=3 do until Z1+1 > lR if not cells(Z1,5).value="" then Z1=Z1+1 Z2=Z2+1 else S1=0 Z2=Z2+1 Do until cells(Z2,5).value="" S1=S1+cells(Z2,5).value Z2=Z2+1 Loop cells(Z1,5).value=S1 Z1=Z2 end if loop

Sub TestSummieren() Dim wks As Worksheet Dim Zeile As Long, Zeile1 As Long, dblSumme As Double Dim lR As Long Set wks = ActiveSheet With Application .ScreenUpdating = False End With With wks lR = .Cells(.Rows.Count, 5).End(xlUp).Row dblSumme = 0 For Zeile = 3 To lR If .Cells(Zeile, 5) = "" Then If Zeile1 > 0 Then .Cells(Zeile1, 5) = dblSumme End If dblSumme = 0 Zeile1 = Zeile ElseIf .Cells(Zeile, 1) = "" Then dblSumme = dblSumme + .Cells(Zeile, 5).Value .Cells(Zeile, 5).ClearContents ElseIf .Cells(Zeile, 1) "" Then If Zeile1 > 0 Then .Cells(Zeile1, 5) = dblSumme End If dblSumme = 0 Zeile1 = 0 End If Next If Zeile1 > 0 Then .Cells(Zeile1, 5) = dblSumme End If For Zeile = lR To 1 Step -1 If WorksheetFunction.CountA(.Cells(Zeile, 1), .Cells(Zeile, 5)) = 0 Then .Rows(Zeile).Delete End If Next Zeile End With With Application .ScreenUpdating = True End With End Sub

Beliebteste Forumthreads (12 Monate)

Abfrage in Spalte, aufsummieren nachfolgender Wert

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

305 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Abfrage in Spalte, aufsummieren nachfolgender Wert

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

305 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread