Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1336to1340
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
Inhaltsverzeichnis

Zwischenergebnisse, Startzeilen, -spalten variabel

Zwischenergebnisse, Startzeilen, -spalten variabel
29.10.2013 10:47:36
Dip
Guten Tag Allerseits,
Gerne würde ich eine Problemstellung im Forum einbringen, in der Hoffnung, jemand kennt die Lösung :-)
Im angehängten Excel File sieht man zwei Projekte.
Die von Hand eingegebenen Werte auf Stufe "Task" sollen auf Stufe "AP" summiert werden. Wiederum sollen dann die Werte auf Stufe "AP" auf Stufe "Teilprojekt" summiert werden. Und schlussendlich von Stufe "Teilprojekt" auf Stufe "Projekt".
Da es eine Vielzahl von Projekten geben wird (alle Projekte stehen untereinander und sind lediglich durch leere Zeile getrennt), ist die Verwendung einer Formel performancemässig nicht ideal.
Könnte man diese Problemstellung mittels einem VBA Code lösen?
Ich bin für jeden noch so kleinen Tipp dankbar!
Beste Grüsse
https://www.herber.de/bbs/user/87441.xlsx
Hallo,
jetzt sehen wir dein gewünschtes Ergebnis.
Aber wie ist die Ausgangslage?
Gruß
Rudi
Hallo Rudi,
Guter Hinweis!
Die Ausgangslage sieht folgendermassen aus:
Es besteht lediglich die Struktur, noch keine Zahlen.
Ich würde anschliessend auf Stufe "Task" die Planung machen, also von Hand Zahlen eingeben.
Sobald ich ein Wert für einen Task eingebe, soll der Code den Wert auf Stufe "AP" bis "Projekt" hochsummieren.
Hilft Dir meine Aussage weiter?
Danke und Grüsse
Hallo Dip,
Excel kann ziemlich schnell rechnen.
Solange man die Datei nicht mit Matrix- und komplexen Verweisformel zuschüttet sind Formeln kaum ein Handicap.
Hier eine Makrolösung, die entsprechend der Struktur in Spalte A in Spalte C TEILERGEBNIS-Formeln einfügt und zum Schluß durch ihre Werte ersetzt.
Gruß
Franz
'Makro in einem allgemeinen Modul
'Ermittelt auf Basis hierachisch strukturierter Daten Teilergebnisse
Sub prcTeilergebnisse()
Dim wks As Worksheet
Dim lngZeile As Long
Dim arrZeileL_Stufe(1 To 4) As Long
Dim StatusCalc As Long
Dim intStufe As Integer, intJ As Integer
Dim strText As String
Set wks = ActiveSheet
'Makrobremsen lösen
With Application
.ScreenUpdating = False
.EnableEvents = False
StatusCalc = .Calculation
.Calculation = xlCalculationManual
End With
With wks
lngZeile = .Cells(.Rows.Count, 1).End(xlUp).Row
'Letzte Zeile für Teilergebnis-Formelbereich bei allen Stufen setzen
For intJ = 1 To 4
arrZeileL_Stufe(intJ) = lngZeile
Next
For lngZeile = lngZeile To 3 Step -1
'Stufe ermiteln auf Basis der Anzahl Punkte im Text in Spalte A
strText = Trim(.Cells(lngZeile, 1).Text)
If strText = "" Then
intStufe = 0
Else
intStufe = Len(strText) - Len(VBA.Replace(strText, ".", "")) + 1
End If
'Stufe auswerten
Select Case intStufe
Case 0 'Leerzeile(n) zwischen Projekten
'Letzte Zeile für Teilergebnis-Formelbereich bei allen Stufen setzen
For intJ = 1 To 4
arrZeileL_Stufe(intJ) = lngZeile - 1
Next
Case 1 To 3 'Projekt, Teilprojekt, AP
'TEILERGEBNIS-Formel einfügen
.Cells(lngZeile, 3).FormulaR1C1 = _
"=SUBTOTAL(9,R[1]C:R[" & arrZeileL_Stufe(intStufe) - lngZeile & "]C)"
'Letzte Zeile für Teilergebnis-Formelbereich neu setzen
For intJ = intStufe To 4
arrZeileL_Stufe(intJ) = lngZeile - 1
Next
Case 4 'Task
End Select
Next
'Formeln durch Werte ersetzen
lngZeile = .Cells(.Rows.Count, 1).End(xlUp).Row
With .Range(.Cells(3, 3), .Cells(lngZeile, 3))
.Calculate
'.Value = .Value
End With
End With
'Makrobremsen zurücksetzen
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = StatusCalc
End With
End Sub

Hallo Franz,
Vielen Dank für dein Code! Werde es sofort ausprobieren und anschliessend Feedback geben...
Noch einen Hinweis bzgl. der Ausgangslage:
Zu Beginn besteht lediglich die Struktur, noch keine Zahlen.
Ich würde anschliessend auf Stufe "Task" die Planung machen, also von Hand eine Zahl eingeben.
Sobald ich ein Wert für einen Task eingebe, soll der Code den Wert auf Stufe "AP" bis "Projekt" hochsummieren.
Hoffe dies hilft meine Problemstellung zu präzisieren.
Danke und Beste Grüsse
Nochmals Hallo Franz,
Der Code rechnet korrekt die Werte hoch, tiptop!
Die Formel wird jedoch nicht überschrieben, sondern bleibt in der Zelle erhalten...?
Wäre es möglich, das Hochsummieren auf Monatsbasis zu erweitern? Also Januar-Dezember 2013, eine Spalte (Summenspalte Jan-Dez für das entsprechende Jahr) überspringt, dann Januar-Dezember 2014, eine Spalte überspringt, Jan-Dez 2015 usw...?
Dann wäre es perfekt!
Danke für Deine Aufmerksamkeit!
Grüsse
Dip
Hallo Dip,
hier inkl. Formeln/Werte für die Monate.
Die Formeln werden jetzt durch die Werte ersetzt, da hatte ich vergessen, eine Kommentartzeile wieder zu aktivieren.
Gruß
Franz
'Makro in einem allgemeinen Modul
'Ermittelt auf Basis hierachisch strukturierter Daten Teilergebnisse
Sub prcTeilergebnisse()
Dim wks As Worksheet
Dim lngZeile As Long, lngSpalte As Long
Dim arrZeileL_Stufe(1 To 4) As Long
Dim StatusCalc As Long
Dim intStufe As Integer, intJ As Integer
Dim strText As String
Set wks = ActiveSheet
'Makrobremsen lösen
With Application
.ScreenUpdating = False
.EnableEvents = False
StatusCalc = .Calculation
.Calculation = xlCalculationManual
End With
With wks
lngZeile = .Cells(.Rows.Count, 1).End(xlUp).Row
'Letzte Zeile für Teilergebnis-Formelbereich bei allen Stufen setzen
For intJ = 1 To 4
arrZeileL_Stufe(intJ) = lngZeile
Next
For lngZeile = lngZeile To 3 Step -1
'Stufe ermiteln auf Basis der Anzahl Punkte im Text in Spalte A
strText = Trim(.Cells(lngZeile, 1).Text)
If strText = "" Then
intStufe = 0
Else
intStufe = Len(strText) - Len(VBA.Replace(strText, ".", "")) + 1
End If
'Stufe auswerten
Select Case intStufe
Case 0 'Leerzeile(n) zwischen Projekten
'Letzte Zeile für Teilergebnis-Formelbereich bei allen Stufen setzen
For intJ = 1 To 4
arrZeileL_Stufe(intJ) = lngZeile - 1
Next
Case 1 To 3 'Projekt, Teilprojekt, AP
'TEILERGEBNIS-Formel einfügen
.Cells(lngZeile, 3).FormulaR1C1 = _
"=SUBTOTAL(9,R[1]C:R[" & arrZeileL_Stufe(intStufe) - lngZeile & "]C)"
'Letzte Zeile für Teilergebnis-Formelbereich neu setzen
For intJ = intStufe To 4
arrZeileL_Stufe(intJ) = lngZeile - 1
Next
Case 4 'Task
End Select
Next
'Formeln für Monate kopieren
lngZeile = .Cells(.Rows.Count, 1).End(xlUp).Row
For lngZeile = 3 To lngZeile
If InStr(1, .Cells(lngZeile, 3).FormulaR1C1, "=SUBTOTAL(") > 0 Then
For lngSpalte = 5 To .Cells(2, .Columns.Count).End(xlToLeft).Column Step 13
.Cells(lngZeile, 3).Copy
With .Range(.Cells(lngZeile, lngSpalte), .Cells(lngZeile, lngSpalte + 11))
.PasteSpecial Paste:=xlPasteFormulas
.Calculate
.Value = .Value 'Formeln durch Werte ersetzen
End With
Next
End If
Next
'Formeln durch Werte ersetzen in Spalte C
lngZeile = .Cells(.Rows.Count, 1).End(xlUp).Row
With .Range(.Cells(3, 3), .Cells(lngZeile, 3))
.Calculate
.Value = .Value
End With
End With
'Makrobremsen zurücksetzen
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = StatusCalc
End With
End Sub

Super, super, super, Du bist mein Held Franz! :-)
Es rechnet alles sauber hoch und auch die Monatsspalten klappen optimal...
Bei einem Zeitraum von 2013-2035 und im Durchschnitt 30 Projekte rechnet auch Excel mit einem VBA Code ein bisschen länger...
Könnte man es soweit optimieren, indem nur der Bereich berechnet wird indem eine Eingabe gemacht wurde?
Beste Grüsse
Dip
Hi Vorname, :-)
vielleicht rennt das hier etwas schneller:
Option Explicit
Sub AdditionenVBA()
Dim lngZ As Long, lngC As Long, arQ, ZW() As Double
Dim zz As Long, ST As Long, cc As Long
lngZ = Cells(Rows.Count, 1).End(xlUp).Row - 2
lngC = Cells(2, Columns.Count).End(xlToLeft).Column
arQ = Cells(3, 1).Resize(lngZ, lngC)
ReDim ZW(1 To 3, 3 To lngC)   ' Zwischenwerte Stufen 1-3, Spalten ab C
For zz = lngZ To 1 Step -1
If arQ(zz, 1)  "" Then
ST = Len(arQ(zz, 1)) - Len(Replace(arQ(zz, 1), ".", "")) + 1
Select Case ST
Case 1
ZW_Ausgabe ZW, zz, 1
Case 2 To 3
For cc = 3 To lngC
If cc Mod 13  4 Then _
ZW(ST - 1, cc) = ZW(ST - 1, cc) + ZW(ST, cc)
Next cc
ZW_Ausgabe ZW, zz, ST
Case 4
For cc = 3 To lngC
If cc Mod 13  4 Then _
ZW(ST - 1, cc) = ZW(ST - 1, cc) + arQ(zz, cc)
Next cc
Case Else: Stop
End Select
End If
Next zz
End Sub

Sub ZW_Ausgabe(WW, z As Long, tt As Long)
Dim dd As Long, cc As Long, w12(0, 1 To 12) As Double
Cells(z + 2, 3) = WW(tt, 3)                     ' Total
WW(tt, 3) = 0
For dd = 0 To Fix(UBound(WW, 2) / 13) - 1       ' x Jahre
For cc = 1 To 12                             ' je 12 Monate
w12(0, cc) = WW(tt, 13 * dd + 4 + cc)
WW(tt, 13 * dd + 4 + cc) = 0
Next cc
Cells(z + 2, 5 + 13 * dd).Resize(, 12) = w12 ' für 1 Jahr
Next dd
End Sub
Damit erübrigt sich vielleicht die Umsetzung deines Wunsches, nur den Bereich mit der Eingabe zu berechnen.
Dazu würde man wohl mit dem Change-Ereignis arbeiten. Allerdings würde man auch das wieder abschalten wollen,
wenn man viele Daten in mehrere Bereiche eingeben will. Dann soll ja nicht dauernd das Programm laufen,
sondern erst nach Abschluss aller Eingaben.
Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich
Hallo Dip,
wenn du während der Dateneingabe laufend aktualisierte Summenwerte angezeigt haben möchtest, dann sollten die TEILERGEBNIS-Formeln nicht durch ihre Werte erstzt werden.
Die vielen Formeln wirken sich "nur" beim Öffnen und Speichern aus, da die datei ca. 3 bis 4 mal so groß wird und einmalig alle Zellen berechnet werden.
Die Verzögerung zur Neuberechnung nach der Eingabe ist marginal, da ja immer nur die Daten des jeweiligen Projekts aktualisert werden müssen.
Hier deine Datei, so das das Makro nur die Formeln einträgt.
https://www.herber.de/bbs/user/87454.xlsm
Ich hab die Datei mit über 500 Zeilen getestet. Die Neuberechnung geht wirklich flott.
Ein weiterer Vorteil: Du kannst das Makro auch in einer externen Datei speichern (z.B. persönliche Makroarbeitsmappe) und deine Daten-Datei bleibt makrofrei.
Ich hab auch Erwin's Lösung getestet. Die ist wirklich schnell. Optimal konfiguriert dauert die Neuberechnung nur wenige Sekunden.
Mich hat dann der Ergeiz gepackt und ich hab das Ganze so konfiguriert, dass nach jeder Eingabe die Summenwerte neu berechnet werden. Da ja jeweils immer nur Daten für ein Projekt geändert werden, werden auch nur die Zeilen zu diesem Projekt aktualisiert.
Die Verzögerung nach der Eingabe ist im 10tel Sekunden-bereich. Per Schalter kann man die Neuberechnung nach jeder Eingabe auch unterdrücken.
https://www.herber.de/bbs/user/87455.xlsm
Gruß
Franz
Hi Franz,
statt "Erwin's" fände ich "Erichs" besser.
Nebenbei nett zu lesen:
http://www.apostroph.de/
http://www.apostrophen-alarm.de/
Ansonsten gibt's natürlich keinen Grund zum Meckern: Die VBA-Lösung hast du prima ausgebaut, finde ich! :-)
Rückmeldung muss nich! - Grüße aus Kamp-Lintfort von Erich und: Schönes Wochenende allerseits!
Guten Tag Allerseits!
Ich bin von Eurer Hilfsbereitschaft und Kompetenz einfach nur beeindruckt!
Die optimierte Lösung von Franz basierend auf Erich's Code funktioniert sogar besser als ich es mir vorgestellt hatte.
Vielen Dank für Eure Hilfe, Franz und Erich, und wünsche Euch alles Gute!
Beste Grüsse und vielleicht bis bald wieder :-)
Dip
Hi Vorname,
danke für deine Rückmeldung!
Hast du mal in die Websites geschaut, die ich unter "Nebenbei nett zu lesen:" verlinkt habe?
Wenn ja - wie kannst du dann noch "Erich's" statt "Erichs" schreiben? ;-)
Grüße aus Kamp-Lintfort von Erich
Hi Erich,
Mein Enthusiasmus Dein Code in mein Arbeitsdokument einzuarbeiten war grösser als die Website zu lesen ^^ Ich werde dies aber noch nachholen!
Würde gerne noch eine kurze nachfrage stellen wenn erlaubt :-)
Und zwar, wo müsste ich ansetzen wenn ich die Anzahl Stufen der Struktur erhöhen möchte?
(z.B. 37.1.2.1.1.1 etc. also mehr als 4 Stufen)
Beste Grüsse!
Dip
Hi,
hier eine Version (von Franz' Erweiterung), bei der die Stufenzahl mittels Konstante vorgegeben wird.
Wenn du die Zahl ändern willst, brauchst du nur die Konstante zu ändern:
Sub AdditionenVBAProjekt(ByVal Zeile1 As Long, ByVal Zeile2 As Long)
Dim lngZ As Long, lngC As Long, arQ, ZW() As Double
Dim zz As Long, ST As Long, cc As Long, StatusCalc As Long
Const AnzSt As Long = 4                             ' Anzahl Stufen
With ActiveSheet
lngZ = Zeile2 - Zeile1 + 1
lngC = .Cells(2, Columns.Count).End(xlToLeft).Column
arQ = Cells(Zeile1, 1).Resize(lngZ, lngC)
End With
ReDim ZW(1 To AnzSt - 1, 3 To lngC) ' Zwischenwerte pro Stufe, Spalten ab C
With Application                 ' Makrobremsen lösen
.ScreenUpdating = False
.EnableEvents = False
StatusCalc = .Calculation
.Calculation = xlCalculationManual
End With
For zz = lngZ To 1 Step -1
If arQ(zz, 1)  "" Then
ST = Len(arQ(zz, 1)) - Len(Replace(arQ(zz, 1), ".", "")) + 1
Select Case ST
Case 1
ZW_Ausgabe ZW, zz, 1, Zeile1
Case 2 To AnzSt - 1
For cc = 3 To lngC
If cc Mod 13  4 Then _
ZW(ST - 1, cc) = ZW(ST - 1, cc) + ZW(ST, cc)
Next cc
ZW_Ausgabe ZW, zz, ST, Zeile1
Case AnzSt
For cc = 3 To lngC
If cc Mod 13  4 Then _
ZW(ST - 1, cc) = ZW(ST - 1, cc) + arQ(zz, cc)
Next cc
Case Else: Stop
End Select
End If
Next zz
'Makrobremsen zurücksetzen
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = StatusCalc
End With
End Sub
Wesentlich: Als Quellwerte werden immer nur die Daten der untersten Stufe verarbeitet.
Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich
Hi Erich,
Danke für Dein Feedback!
Ich habe in der Zwischenzeit herausgefunden wie ich die Anzahl Stufen anpassen kann, aber Deine Lösung mit einer Konstante ist natürlich viel eleganter, super!
Das ist korrekt so, es soll lediglich die Werte der untersten Stufe hochrechnen.
Eine Schwierigkeit ist mir noch aufgetreten bei der Einarbeitung des Codes in die Arbeitsmappe.
Ab welche Spalte bzw Zeile der Code beginnen soll. Aktuell ab Spalte C. Je nach hinzugefügte Spalte bzw. Zeile sollte der Code angepasst werden. Wäre dies auch mit einer Konstante lösbar? (Spalte D muss nicht übersprungen werden).
Beste Grüsse
Dip
Hallo Dip,
Und zwar, wo müsste ich ansetzen wenn ich die Anzahl Stufen der Struktur erhöhen möchte?
Diese Frage hab ich eigenlich schon erwartet, da die Gliederungsstruktur von Projekten (Neudeutsch: WBS = work breakdown structure) oft 5 und mehr Ebenen hat.
Ich hab Erichs Makro jetzt so umgestrickt, dass bis zu 9 Stufen angegeben werden können. Außerdem ist es nicht erforderlich, dass zu jedem Element eine Unterstruktur vorhanden sein muss.
Beispiel:
Die Werte mit "E" in Spalte D sind Eingabewerte, die mit "B" sind berechnete Werte.
Textdatei mit angepasstem Hauptmakro:
https://www.herber.de/bbs/user/87473.txt
Gruß
Franz
Hallo Dip,
ich hab das Ganze jetzt so konfiguriert, dass du per Ändern von Konstanten im Modul "Modul_Erich" folgende Parameter einstellen kannst:
- Spalte mit Totalwerten
- Spalte mit dem 1. Januar
- Zeile mit den Monaten
- Zeile mit dem 1. Projekt
- mögliche Anzahl Ebenen/Stufen
Alle Makros sind angepasst, auch die unter dem Tabellenblatt, so dass sie auf die als globale Konstanten festgelegten Werte zugreifen.
Gruß
Franz
https://www.herber.de/bbs/user/87478.xlsm
Hallo Franz,
Hoffe Dir geht es soweit gut!
Ich habe Deine Lösung in meinem Planungsfile eingebaut und es läuft soweit optimal, nochmals Vielen Dank an dieser Stelle für Deine Hilfe!
Ein Detail gäbe es da noch... und zwar betrifft es die Summenspalte über alle Jahre (Spalte E) und die Summenspalte des entsprechenden Jahres (Spalte R/AE/AR etc..)
Der Code für die Summenspalte über alle Jahre scheint nicht zu funktionieren und wenn die Summenspalte pro Jahr mit dem Code statt mit Formeln berechnet werden könnte wäre dies optimal.
Wären diese Anpassung möglich umzusetzen?
Danke und Beste Grüsse
Dip

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

Betreff
Datum
Anwender
Anzeige
AW: Zwischenergebnisse, Startzeilen, -spalten variabel
29.10.2013 10:50:46
Dip
Ps. da ich den Code erweitert habe, wäre es sehr hilfreich wenn ich genau wüssen würde, wo die Anpassungen eingefügt wurden bzw. eingesetzt werden müssen, damit ich es übernehmen kann :-)

AW: Zwischenergebnisse, Startzeilen, -spalten variabel
29.10.2013 17:06:53
Dip
bitte löschen...
Anzeige

299 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige