Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
896to900
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
896to900
896to900
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

tabelle spaltenweise aufaddieren

tabelle spaltenweise aufaddieren
22.08.2007 16:40:00
Reptil
...und schon wieder brauche ich eure hilfe : /
dank eurer hilfe habe nun eine tabelle, die horizontal in teiltabellen untergliedert ist.
( für nähere infos https://www.herber.de/forum/messages/899226.html)
nun soll alles, was zwischen zwei leerzeilen steht addiert werden. das klappt soweit auch recht gut mit folgendem code:

Sub einfügenErgebnis()
LastRow = Cells(65536, 2).End(xlUp).Row + 1
For i = 12 To LastRow
If Cells(i, 2).Value = emtpy Then
Cells(i, 2) = x
x = 0
Else: x = (x + Cells(i, 2).Value)
End If
Next i
End Sub


nur ist es jetzt so, das nicht nur die daten in spalte 2 ( B ) addiert werden sollen. da die breite der tabelle beliebig lang sein kann ergibt das vergeben von ewig vielen variablen natürlich wenig sinn. meine idee war nun, quasi um die vorhandene for schleife eine weitere zu basteln, die nicht die zeilen, sondern die spalten kontrolliert. auch eine gesammtsumme soll entstehen.
ich habe eine kleine beispieldatei geschrieben, die rot markierten felder sind das, was mit vba ausgerechnet werden soll.
https://www.herber.de/bbs/user/45281.xls
ich hoffe, das ihr mir ein weiteres mal helfen könnt
liebe grüße

14
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: tabelle spaltenweise aufaddieren
22.08.2007 17:36:00
Peter
Hallo Reptil,
versuche es so:


Option Explicit
Sub einfügenErgebnis()
Dim lLetzte  As Long
Dim iSpalte  As Integer
Dim lZeile   As Long
Dim dSumme   As Double
   Application.ScreenUpdating = False
    lLetzte = Cells(65536, 1).End(xlUp).Row + 1
    For iSpalte = 2 To Cells(11, 256).End(xlToLeft).Column
       For lZeile = 12 To lLetzte
          If Cells(lZeile, 1).Value = "" Then
             Cells(lZeile, iSpalte) = dSumme
             dSumme = 0
          Else: dSumme = (dSumme + Cells(lZeile, iSpalte).Value)
          End If
       Next lZeile
    Next iSpalte
    For lZeile = 12 To lLetzte
       If Cells(lZeile, 1).Value = "" Then
          For iSpalte = 2 To Cells(11, 256).End(xlToLeft).Column
             dSumme = dSumme + Cells(lZeile, iSpalte).Value
          Next iSpalte
          Cells(lZeile, Cells(11, 256).End(xlToLeft).Column + 1).Value = dSumme
          dSumme = 0
       End If
    Next lZeile
    Application.ScreenUpdating = True
End Sub 


Gruß Peter

Anzeige
AW: tabelle spaltenweise aufaddieren
23.08.2007 08:48:35
Reptil
erst mal danke für eure hilfe.
leider komme ich mit beiden antworten nicht ganz so zurecht. mein orginal file ist nciht ganz so aufgebaut wie das beispiel, die zu berechnende tabelle beginnt erst in zeile 8... und irgendwie macht mir das umformen mehr probleme als ich dachte o.O
@Peter bei deiner formal habe ich nun das problem, dass nur die erste spalte berechnet wird... habe ich beim umbau was grundlegendes falsch gemacht?

Sub einfügenErgebnis()
Dim lLetzte  As Long
Dim iSpalte  As Integer
Dim lZeile   As Long
Dim dSumme   As Double
Application.ScreenUpdating = False
lLetzte = Cells(65536, 1).End(xlUp).Row + 1
For iSpalte = 8 To Cells(11, 256).End(xlToLeft).Column
For lZeile = 12 To lLetzte
If Cells(lZeile, 1).Value = "" Then
Cells(lZeile, 1).Value = Cells(lZeile - 1, 1)
Cells(lZeile, 2).Value = Cells(lZeile - 1, 2)
Cells(lZeile, 3).Value = Cells(lZeile - 1, 3)
Cells(lZeile, 6).Value = "GESAMT"
Cells(lZeile, iSpalte) = dSumme
dSumme = 0
Else: dSumme = (dSumme + Cells(lZeile, iSpalte).Value)
End If
Next lZeile
Next iSpalte
For lZeile = 12 To lLetzte
If Cells(lZeile, 1).Value = "" Then
For iSpalte = 7 To Cells(11, 256).End(xlToLeft).Column
dSumme = dSumme + Cells(lZeile, iSpalte).Value
Next iSpalte
Cells(lZeile, Cells(11, 256).End(xlToLeft).Column + 1).Value = dSumme
dSumme = 0
End If
Next lZeile
Application.ScreenUpdating = True
End Sub


Anzeige
AW: tabelle spaltenweise aufaddieren
23.08.2007 12:54:00
Daniel
HI
"mein orginal file ist nciht ganz so aufgebaut wie das beispiel"
selbst Schuld, warum nimmst du nicht einfach einen Ausschnitt aus dem Original (ggf mit veränderten Daten?).
Wir können uns hier immer nur auf das beziehen, was du uns zur Verfügung stelltst.
Außderdem beginnt dein Beispiel explizit bei Zeile 12, dein Original aber angeblich bei 8.
Ich verstehe nicht, warum du in dein Beispiel derartige Veränderungen einbaust (sollte aber kein Problem sein, im Makro Zeile 12 durch Zeile 8 zu ersetzten)
Gruß, Daniel

AW: tabelle spaltenweise aufaddieren
23.08.2007 13:15:00
Reptil
...das ich daran selbst schuld bin, ist mir auch klar....
fehlerhafter weiße habe ich in meinem letzten post auch zeile 8 statt spalte 8 geschrieben -.-
ich dachte auch, dass es ja an sich kein problem sein sollte, aber irgendwie bekomme ich es nicht gebacken...
in der hoffnung, dass ihr mir nicht zu böse seid hab cih nun eins gebastelt, dass die realität genauer abbildet.
https://www.herber.de/bbs/user/45310.xls
wieder ist das rote das, was automatisch passieren soll.
grüße

Anzeige
"frage offen" vergessen OT
23.08.2007 13:26:00
Reptil
!

AW: "frage offen" vergessen OT
23.08.2007 14:12:00
Daniel
Hi
Mal ne Frage:
sollen in den roten Zellen immer die Summe für 1 PRODUKT (Spalte b) oder für eine REGION (Spalte a) gebildet werden ?, dh. ist einer dieser beiden Begriffe zwischen 2 Leerzeilen immer gleich und eindeutig, dh. er kommt nur an dieser Stelle vor und nicht noch irgendwo anders?
in diesem Fall könnte man die Funktion SUMMEWENN verwenden, was das Makro etwas vereinfachen würde.
noch ne Frage, im ersten Beispiel wurde noch eine Gesamtsumme für jede Summenzeile gebildet.
die fehlt hier. Ist sie noch erforderlich oder nicht?
Gruß, Daniel

Anzeige
AW: "frage offen" vergessen OT
23.08.2007 14:20:00
Reptil
hallo
der bereich zwischen zwei leerzeilen ist nach produkten sortiert, also soll auch die summe nach den produkten gebildet werden. die regionen sind für die tabelle an sich uninteressant.
gelöst werden muss das ganze in einem makro, da die tabellen von einem anderen system kommen und erst danach über andere makros in die vorhandene form kommen. formeln würden also gnadenlos überschrieben.
die gesammtsumme ist noch vorhanden, nur habe ich sie im neuen beispiel in spalte G gesetzt. wieder eine abweichung zum ersten beispiel, sorry... aber sorum ist es doch sinnvoller...
liebe grüße

Anzeige
AW: "frage offen" vergessen OT
23.08.2007 15:01:58
Daniel
Hi
also hier nochmal mein modifizierter Löungsansatz, angepasst an die neuen voraussetzungen und etwas optimiert (hoffe ich). es werden zwar Formeln verwendet, aber diese anschließend durch Fix-Werte ersetzt.
dadurch wird das Makro relativ kompakt, ohne komplexe verschachtelte Schleifen und auch ausreichend schnell.

Sub Teilsummen_einfügen()
Dim Ze1 As Long
Dim Ze2 As Long
Dim Spalten As Long
Dim Zelle As Range
Spalten = Range("IV11").End(xlToLeft).Column - 7
With Range(Cells(12, 2), Cells(65536, 2).End(xlUp).Offset(1, 0))
For Each Zelle In .SpecialCells(xlCellTypeBlanks)
Ze2 = Zelle.Row - 1
Ze1 = Zelle.Offset(-1, 0).End(xlUp).Row
If Zelle.Offset(-2, 0) = "" Then Ze1 = Ze2
Cells(Zelle.Row, 8).Resize(, Spalten).FormulaR1C1 = "=sum(r" & Ze1 & "C:R" & Ze2 & "C)"
Cells(Zelle.Row, 7).FormulaR1C1 = "=SUM(RC[1]:RC[" & Spalten & "])"
Zelle.EntireRow.Formula = Zelle.EntireRow.Value
Next
End With
End Sub


Gruß, Daniel

Anzeige
AW: "frage offen" vergessen OT
23.08.2007 15:24:12
Reptil
hey daniel...
DANKE DANKE DANKE : )
juhu, jetzt klappt alles : ) ... ich hab zwar ehrlich gesagt den code raktisch nciht verstanden, aber das ist ja auch egal : D schnell ist es auch..
sorry nochmal für das falsche beispiel...
grüße

AW: "frage offen" vergessen OT
23.08.2007 16:59:14
Daniel
Hi
eigentlich ganz einfach:
der Code springt in Spalte 2 von Leer Zelle zu leerer Zelle und schreibt in in die gefundenen Zeilen die normale Summenformel rein.
Dabei wird die Ober- und Untergrenze für die Summenbildung immer neu berechnet:
- obergrenze ist die Zeile direkt drüber (Ze2)
- untergrenze ist die Zeile mit der nächste Leerzelle oberhalb (wird Zelle.End(xlup) ermittelt) (Ze1)
gehe den Code mal im Einzelstepmodus durch und schau dir an, was passiert.
zu diesem Zweck kannst du ihn auch so ergänzen (aber zu zu diesem)

Sub Teilsummen_einfügen()
Dim Ze1 As Long
Dim Ze2 As Long
Dim Spalten As Long
Dim Zelle As Range
Spalten = Range("IV11").End(xlToLeft).Column - 7
Range(Cells(12, 2), Cells(65536, 2).End(xlUp).Offset(1, 0)).select
With Range(Cells(12, 2), Cells(65536, 2).End(xlUp).Offset(1, 0))
For Each Zelle In .SpecialCells(xlCellTypeBlanks)
Zelle.select
Ze2 = Zelle.Row - 1
Ze1 = Zelle.Offset(-1, 0).End(xlUp).Row
If Zelle.Offset(-2, 0) = "" Then Ze1 = Ze2
Cells(Zelle.Row, 8).Resize(, Spalten).select
selection.FormulaR1C1 = "=sum(r" & Ze1 & "C:R" & Ze2 & "C)"
Cells(Zelle.Row, 7).select
selection.FormulaR1C1 = "=SUM(RC[1]:RC[" & Spalten & "])"
Zelle.EntireRow.Formula = Zelle.EntireRow.Value
Next
End With
End Sub


Gruß, Daniel

Anzeige
AW: "frage offen" vergessen OT
24.08.2007 10:17:00
Reptil
hey daniel, danke erstmal für deine erklärung.. nun kann cih es mir vorstellen : )
aber ich fürchte ich muss dich doch noch mal nerven..
das makro läuft sauber durch, klappt alles ganz prima. nur den letzten zahlenblock will er nicht addieren. was an dem anders ist als an den anderen weiß ich auch nciht...es ist so, dass die daten der tabelle aus dem sap kommen, habe auch schon häufiger in der letzten zeile eine anfere formatierung als in den anderen beobachtet.... aber die formatierung dürfte doch keine auswirkung auf die formal haben? zumal in den beobachteten fällen die letzte zeile die formatierung der darunterliegenden zeilen angenommen hatte, also die standarteinstellung von excel....
ich bin verwirrt...

Anzeige
AW: "frage offen" vergessen OT
24.08.2007 19:42:56
Daniel
Hi
was soll ich dazu sagen, wenn ich nicht weiß, wie deine Daten aussehen?
Formatierung spielt eigentlich keine Rolle
Wichtig ist die Spalte B (2), hier wird ermittelt, auf vieviele Zeilen, die Berechnung angewendet wird.
da sollten bis zum schluss Werte drinnstehen.
gruß, Daniel

AW: "frage offen" vergessen OT
23.08.2007 14:41:23
Reptil
wenn notwendig könnte ich auchmal den kompletten vba code schicken, aber da alles weitere ja funktioniert und der restliche code keinen einfluss auf diese funktion haben dürfte denke ich nicht, das der code gebraucht wird...

AW: tabelle spaltenweise aufaddieren
22.08.2007 18:19:00
Daniel
Hi
ich würde für dieses Problem einen anderen Lösungsansatz wählen, da daß Aufaddieren von Einzelwerten in einer grösseren Tabelle schon einige Zeit in Anspruch nehmen kann.
Ich würde eine Summenformel verwenden und diese Summenformel per Makro in die Zwischenzeilen einfügen.
Falls in der Datei Fix-Werte benötigt werden, oder die Datei durch die Formeln zu langsam wird, kannst du die letzte Zeile innerhalb der Schleife wieder aktivieren (erstes Hochkomma entfernen), dann werden die berechnungsformeln durch ihre Ergebnisse als Fix-Werte ersetzt.
Hier mal ein Makro für deine Datei.

Sub Teilsummen_einfügen()
Dim Formel_1 As String, Formel_2 As String
Dim Spalten As Long
Dim Zelle As Range
Spalten = Range("IV11").End(xlToLeft).Column - 1
Formel_1 = "=SUMIF(R11C1:R[-1]C1,R[-1]C1,R11C:R[-1]C)"
Formel_2 = "=SUM(RC1:RC[-1])"
With Range(Cells(12, 1), Cells(65536, 1).End(xlUp).Offset(1, 0))
For Each Zelle In .SpecialCells(xlCellTypeBlanks)
Zelle.Offset(0, 1).Resize(, Spalten).FormulaR1C1 = Formel_1
Zelle.Offset(0, 1 + Spalten).FormulaR1C1 = Formel_2
'Zelle.EntireRow.Formula = Zelle.EntireRow.value 'diese Zeile nur, wenn Fixwerte statt  _
Formeln gewünscht
Next
End With
End Sub


Gruß, Daniel

Anzeige

34 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige