Automatische Summenbildung per VBA

ChrisW · 1970-01-01T00:00:00+00:00

Hallo Leute, ich habe ein Problem mit der Programmierung von Summenformeln [Bild: Userbild] Die weissen Zellen in Spalte B enthalten die Zahlenwerte, alle farbigen Zellen die in Zeile C stehenden Formeln. Ich muss automatisch die in Spalte C geschriebenen Formeln erzeugen in der entsprechende Zelle in Spalte B In die hellhelben Zellen (Colorindex 36) soll die Summe der darunterliegenden weissen Zellen. In die gelben Zellen (Colorindex 6) die Summe der hellgelben Zellen In die apricot farbenen Zellen (Colorindex 40) die Summe der Gelben Zellen usw, aber die Summierung soll nur bis zur nächsten "dunkleren" Farbe gehen. D.h in der Obersten Zelle steht die Gesamtsumme aller weissen Zellen Diese Tabelle ist nur ein kleiner Ausschnitt aus einer Tabelle mit 20 Spalten und über 400 Zeilen, und die Anpassung jedes Mal von Hand zumachen ist schon sehr mühselig. Leider verzweifle ich aber an der Programmierung Ich habe zu verdeutlichung in Spalte A einen Index eingefügt, damit man sieht was übergeordnet ist. Ich hoffe Ihr versteht mein Problem und könnt mir helfen Vielen Dank Euer Chris

...schiedl Schriftstile wie kursiv, fett usw, Chris,
das wäre aber hier nicht optimal, wenn die ganze Struktur mit Lücken für die Summierungsformeln so aus SAP kommt...
Ein Ausfüllen der Lücken per VBA ist zwar mögl, aber dazu müssen einheitl Kriterien existieren, damit das ggf auch verallgemeinert wdn kann; das Vorhandensein einer Lücke bei gleichzeitig vorhandenem Vorspaltentext allein wird wohl nicht reichen, es sei denn, den Oberpositionen desselben (und ihren zugehörigen Unterpositionen) sind irgendwo eindeutige Indizes zugeordnet. Das würde sich relativ einfach darstellen, wenn die Anzahl der Summanden pro Oberbegriff stets gleich wäre. Ist sie das nicht, also stattdessen dynamisch, wird's problematisch — ihre MaxMenge müsste dann explizit aufgeführt wdn und die ggf nicht vorhandenen 0 gesetzt wdn.
Man könnte statt mit (externen) Indizes auch mit Farben arbeiten, aber die müssen dann auch wirklich physisch vorhanden sein. Wenn also entweder Indizes (irgendwo) oder Farben tatsächlich vorhanden sind, ließe sich das lösen, aber wohl eher nicht mit dem MakroRecorder... ;-)
Evtl gäbe es auch eine FmlLösung, die sich an Markierungen in einer Hilfsspalte orientiert. Zumindest die niedrigsten Oberpositionen wären so ermittelbar. Außerdem gibt's noch die xlFkt DBSUMME, die alles summiert, was den gleichen Index hat (wird in separaten Zellen neben bzw oberhalb der Tabelle angegeben). Dazu müsste der aber entsprechend umgestaltet wdn und außerdem Bestandteil der Tabelle sein (evtl ausgeblendet). In der Richtung solltest du mal (alternativ) probieren! Werde das wahrscheinlich auch mal versuchen... ;-)
Gruß Luc :-?

Hallo Chris,
hier meine beiden VBA-Lösungen.
Gruß
Franz
Lösung 1 generiert Teilergebnis-Formeln

Option Explicit
'Variablendeklaration
Private ws As Worksheet, lZeile As Long
Private ZeileEnde As Long, ZeileStart As Long, ZeileLetzte As Long
Private Const lSpalteText As Long = 1
Private Const lSpalteFormel As Long = 2
Private Const Zeile_1 As Long = 5 '1. Zeile mit Werten
'Colorindex der zu vergleichenden Farben
Private Const Farbe_1 As Long = 45 'Farbe der obersten Ebene, Ebene 1
Private Const Farbe_2 As Long = 44 'Farbe Ebene 2
Private Const Farbe_3 As Long = 40 'Farbe Ebene 3
Private Const Farbe_4 As Long = 6  'Farbe Ebene 4
Private Const Farbe_5 As Long = 36 'Farbe Ebene 5
Private Const Farbe_6 As Long = 0  'Farbe der untersten Ebene oder ohne Füllfarbe, Ebene 6
Sub TeilergebnisformelnEinfuegen()
'Fügt auf Basis der Zellfarben Teilergebnis-Summenformeln ein
Set ws = ActiveSheet
With ws
ZeileLetzte = .Cells(.Rows.Count, lSpalteText).End(xlUp).Row
End With
'Summenformeln Ebene 5 einfügen
Call TeilErgebnis(Farbe:=Farbe_5)
'Summenformeln Ebene 4 einfügen
Call TeilErgebnis(Farbe:=Farbe_4)
'Summenformeln Ebene 4 einfügen
Call TeilErgebnis(Farbe:=Farbe_3)
'Summenformeln Ebene 4 einfügen
Call TeilErgebnis(Farbe:=Farbe_2)
'Summenformeln Ebene 4 einfügen
Call TeilErgebnis(Farbe:=Farbe_1)
End Sub
Sub TeilErgebnis(Farbe As Long)
'Teilergebnis-Summenformeln bei Farbe einfügen
With ws
ZeileEnde = ZeileLetzte
For lZeile = ZeileLetzte To Zeile_1 Step -1
With .Cells(lZeile, lSpalteFormel)
If .Interior.ColorIndex = Farbe Then
ZeileStart = lZeile + 1
.Formula = "=SUBTOTAL(9,R[1]C[0]:R[" & ZeileEnde - ZeileStart + 1 & "]C[0])"
'Nächste Zelle der Ebene 6 finden
Do Until ws.Cells(lZeile, lSpalteFormel).Interior.ColorIndex = Farbe_6 _
Or ws.Cells(lZeile, lSpalteFormel).Interior.ColorIndex = xlColorIndexNone
lZeile = lZeile - 1
If lZeile

Lösung 2 generiert Summenformeln mit den Summenzellen der nächsten Unterebene als Parameter.

Option Explicit
'Variablendeklaration
Private ws As Worksheet, lZeile As Long
Private ZeileEnde As Long, ZeileStart As Long, ZeileLetzte As Long
Private Const lSpalteText As Long = 1
Private Const lSpalteFormel As Long = 2
Private Const Zeile_1 As Long = 5 '1. Zeile mit Werten
'Colorindex der zu vergleichenden Farben
Private Const Farbe_1 As Long = 45 'Farbe der obersten Ebene, Ebene 1
Private Const Farbe_2 As Long = 44 'Farbe Ebene 2
Private Const Farbe_3 As Long = 40 'Farbe Ebene 3
Private Const Farbe_4 As Long = 6  'Farbe Ebene 4
Private Const Farbe_5 As Long = 36 'Farbe Ebene 5
Private Const Farbe_6 As Long = 0  'Farbe der untersten Ebene oder ohne Füllfarbe, Ebene 6
Sub SummenformelnEinfuegen()
'Fügt auf Basis der Zellfarben Summenformeln ein
Set ws = ActiveSheet
With ws
ZeileLetzte = .Cells(.Rows.Count, lSpalteText).End(xlUp).Row
End With
'Summenformeln Ebene 5 einfügen
Call Summenformel(Farbe1:=Farbe_5, Farbe2:=Farbe_6, Farbe3:=xlColorIndexNone)
'Summenformeln Ebene 4 einfügen
Call Summenformel(Farbe1:=Farbe_4, Farbe2:=Farbe_5)
'Summenformeln Ebene 3 einfügen
Call Summenformel(Farbe1:=Farbe_3, Farbe2:=Farbe_4)
'Summenformeln Ebene 2 einfügen
Call Summenformel(Farbe1:=Farbe_2, Farbe2:=Farbe_3)
'Summenformeln Ebene 1 einfügen
Call TeilErgebnis1(Farbe1:=Farbe_1, Farbe2:=Farbe_2)
End Sub
Sub Summenformel(Farbe1 As Long, Farbe2 As Long, Optional Farbe3 As Long = -1)
'Summenformeln bei Zellen mit Farbe1 einfügen
Dim strFormel As String
If Farbe3 = -1 Then Farbe3 = Farbe2
With ws
ZeileEnde = ZeileLetzte
strFormel = ""
For lZeile = ZeileLetzte To Zeile_1 Step -1
With .Cells(lZeile, lSpalteFormel)
If .Interior.ColorIndex = Farbe2 Or .Interior.ColorIndex = Farbe3 Then
If strFormel = "" Then
strFormel = "=SUM(" & .Address(ReferenceStyle:=xlR1C1)
Else
strFormel = strFormel & ", " & .Address(ReferenceStyle:=xlR1C1)
End If
ElseIf .Interior.ColorIndex = Farbe1 Then
strFormel = strFormel & ")"
.Formula = strFormel
strFormel = ""
End If
End With
Next
End With
End Sub

Automatische Summenbildung per VBA

Forumthread: Automatische Summenbildung per VBA

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Infobox / Tutorial