AW: Gruppierung anhand Ebenennummern per VBA
04.12.2024 10:17:49
Yal
Hallo MCO,
es handelt sich um Ebenen: 1 bekommt die Summe alle zweier, 2 bekommt die Summe "seinen" dreier, es gibt ein 3 der Vierer hat.
Sehr kurze Problembeschreibung, komplizierte Behandlung. Wenn man annimmt, dass die Tiefe nicht vorher festgelegt ist, wird eine Universallösung eine harte Nuss (so mein Anspruch, sonst macht es keinen Spass ;-)
Ich beisse mich an dem Knochen seit ein paar Tagen. Hauptsächlich gedanklich, aber auch mit einer -unvollständigen- Lösungsansatz. Besonders die Kombination einer rekursive Behandlung mit einer Rückgabe in das Blatt macht mich Problem.
Zweite Schwierigkeitsstufe wäre anstatt feste Summen, Summenformeln in der Zellen abzugeben, um eine Autogliederung zu ermöglichen.
Hier mein bisherigen nicht vollständigen Code. Vielleicht kann jemand sein Spass daran haben:
Const EbnSp = 1
Const WerteSp = 2
Const SumSp = 3
Dim Zeile As Long
Sub Summieren_starten()
Range("Tabelle1").ListObject.DataBodyRange.Columns(3).ClearContents 'die Liste ist eine Tabelle umgewandelt worden. Überschrift in Zeile 1, Daten ab Zeile 2
Zeile = 2
Cells(2, SumSp).Value = Summieren(Cells(2, EbnSp).Value) 'erste Zeile, Referenz Gliederungswert
End Sub
Function Summieren(AktEbene As Long) As Double
Dim Summe As Double
Dim NextEb As Long
Dim eigZeile As Long
'AktZeile ist die Zeile der eventuelle Summe, wenn die Rekursion runterkommt
eigZeile = Zeile
'prüft die kommende Ebene
Do While Cells(Zeile, EbnSp).Value > ""
NextEb = Cells(Zeile + 1, EbnSp).Value 'immer das "Selbst" im Bezug zu was danach kommt richten.
Select Case NextEb
Case Is > AktEbene 'Steigend: neue Ebene "reingehen", Summe abnehmen, wenn runterkommt
'eigene verwalten,
'nicht, da nächste Eben vorhanden
'nächste einleiten
eigZeile = Zeile
Zeile = Zeile + 1
Summe = Summe + Summieren(NextEb)
'Rückgabe ablegen
Cells(eigZeile, SumSp).Value = Summe
eigZeile = Zeile
Case AktEbene 'gleiche Ebene
'eigene verwalten,
'Leaf: Werte in Spalte Sum kopieren
Cells(Zeile, SumSp).Value = Cells(Zeile, WerteSp).Value
'Wert in die Summe reinfliessen lassen
Summe = Summe + Cells(Zeile, WerteSp).Value
'nächste einleiten
Zeile = Zeile + 1
Case Is AktEbene 'absteigend: der Ast wird verlassen
'eigene verwalten
'Leaf: Werte in Spalte Sum kopieren
Cells(Zeile, SumSp).Value = Cells(Zeile, WerteSp).Value
'Wert in die Summe reinfliessen lassen
Summieren = Summe + Cells(Zeile, WerteSp).Value
'nächste einleiten
Zeile = Zeile + 1
Exit Function
Case Else '= ""
'eigene verwalten:
'Leaf: Werte in Spalte Sum kopieren
Cells(Zeile, SumSp).Value = Cells(Zeile, WerteSp).Value
'nächste einleiten
'nichts ausser zurückgeben
Summieren = Cells(Zeile, WerteSp).Value
Zeile = Zeile + 1
Exit Function
End Select
Loop
End Function
Ich habe noch eine Schwierigkeit beim "runterkommen", wenn nicht eine Ebene runter (also Richtung root) sondern 2 auf einmal vorkommt.
VG
Yal