Office: Formeltechnische Aufteilung

Hallo zusammen,

Ich habe eine Liste mit Zahlen, die von bestimmten Konten auf andere Konten umgebucht werden sollen. Dazu gibt es festgelegte Buchungsbelege mit 4 Umbuchungszeilen. Wie das nun mal so ist, muss Soll und Haben gleich sein.</SPAN>

Die entsprechende Liste habe ich angehangen. </SPAN>

Bis jetzt habe ich immer so lange händisch gerechnet, bis das irgendwann hingehauen hat. Aber es gibt doch sicher eine Möglichkeit, dass formeltechnisch zu machen.</SPAN>

Ich suche nun sozusagen eine Formel, die mir die ersten 4 Zahlen (größer Null) auf der rechten Seite zusammenaddiert, und sich dann von den Zahlen auf der linken Seite so viele sucht, bis er auf das Ergebnis der 4 Zahlen auf der rechten Seite kommt. Wenn das nicht aufgeht (was es zu 99 Prozent nicht tut), soll er die Zahlen auf der linken Seite so aufteilen, bis er auf die Summe der rechten Seite kommt.</SPAN>

Nun haben beide Seiten 22 Konten. Demzufolge müßte er das maximal 5,5 mal machen.</SPAN>

Laut Beispiel (stark vereinfacht) soll er demzufolge die Summe der ersten 4 Zahlen (>0) nehmen, was 22714,15 Euro sind und sich auf der linken Seite Zahlen (auch max. 4) suchen, die dieser Summe entsprechen, wenn das nicht aufgeht, soll er die aufteilen (im Beispiel müsste der die 56440,61 Euro auf der linken Seite splitten). Das ganze muß der so lange machen, bis die ganzen 87876,06 Euro aufgeteilt sind.</SPAN>

Und diese Aufteilung müsste der mir anzeigen. </SPAN>

Ich hoffe, es ist halbwegs verständlich, was ich meine. :-)


Gruß
Michael</SPAN></SPAN></SPAN>

 

Hallo Michael,

ich habe keine Ahnung ob sowas mit Formeln geht.
Ich stelle es mir auf jeden Fall verdammt kompliziert vor und habe nicht den Ansatz einer Idee wie das zu lösen wäre.
Aber mit VBA ist so eine Aufgabe kein Problem.

In Deine Beispielmappe Den Anhang Michael.xls betrachten
habe ich ein Makro geschrieben.
Es schreibt die von Dir gewünschten "Buchungsblöcke etwas rechts von den Kontentabellen ins Arbeitsblatt.
Mit "STRG - F11" kannst Du den Makroeditor öffnen und Dir den Code ansehen, bzw. das Makro dann auch direkt von dort aus starten.

Ich bin davon ausgegangen, dass Deine Originaldatei exakt genauso aufgebaut ist wie Deine Beispielmappe.
Schau erstmal in meiner Datei was das Makro macht, und wen Du es auf Deine Original-Daten loslässt, dann erstmal nur auf eine Kopie. ;)

Wenn Du Fragen hast oder es Probleme gibt, dann meld Dich.


Ich hoffe geholfen zu haben.


PS:

In den Zellen "B7" und "B8" hast Du werte mit 11 oder 12 Nachkommastellen.
Dies dürfte durch Rundungs-Ungenauigkeiten bei der Ermittlung dieser Werte kommen.
Sowas kann zu Fehlern führen und sollte wohl besser vermieden werden, z.Bsp. indem man den Wert auf zwei Nachkommastellen rundet.
Lass Dich nicht von der Anzeige eines Wertes in Excel täuschen, die wird durch die Zellformatierung bestimmt, muss aber nicht mit dem tatsächlichen Zellwert übereinstimmen.

 

Ich hänge mal noch eine geänderte Version an,
denn folgendes hatte ich nicht bedacht:
Wenn in der linken Liste die Summe der jeweils ersten 4 Beträge kleiner als die Summe der 4 von rechts ist, wird die Vorgabe von Michael nicht erfüllt, aber das Makro läuft durch und produziert falsche Zahlen.
Gut zu testen wenn man die 56440,16 aus Kto 5 mal ins Kto 22 verschiebt.

Die neue Version würde dann solange weiter suchen, bis die Summe größer oder gleich rechts ist, indem bei jedem Versuch eine Zeile tiefer angefangen wird.

Was immer noch nicht funktioniert:
wenn links mehrere Werte genommen werden müssten, die nicht nacheinander stehen, sondern wo andere Werte dazwischen sind.
Ebenfalls funktioniert es nicht, wenn rechts ein so großer Wert steht, dass links 4 Werte nicht ausreichen.
Denn dann müsste rechts gesplittet werden, quasi alles seitenverkehrt.

Vielleicht hat jemand anderes dazu ja noch eine zündende Idee...

 

Hallo Achim,

das ist ja der helle Wahnsinn. Super das das funktioniert. Ich gucke mir das gerade an. Das Makro sieht sehr kompliziert aus. Ich habe bin jetzt immer nur kleine Makros über den Rekorder aufgezeichnet und angepasst. Sehe ich das richtig, dass ich, wenn ich das Makro in meine Liste kopieren und verschiebe, nur deine Verteilung ändern muß? Oder muß da im eigentlichen Code noch etwas angepasst werden?

Ich danke Dir wie verrückt. :-)

Gruß
Michael

 

Hallo Achim,

ich habe noch eine Frage. Ich habe meine Tabelle jetzt fertig gebaut. Die Quelldaten stehen jetzt in K7:O29 (mit Überschrift, ohne die Kontrollsumme unten; ansonsten gleicher Aufbau wie gehabt). Die Auswertung soll in die Spalten Q:U. Ich habe den Code jetzt wie unten stehend verändert. Aber irgendwas stimmt da nicht. Da kommt immer "Typ unverträglich". Ich nehme mal an, dass ich noch irgendwo was ändern muss, da der jetzt versucht, die Auswertung über die Quelle zu schreiben. Aber ich weiß nicht, wo ich was ändern muss. Kannst Du mir da bitte nochmal helfen?

Danke Dir und schönes Wochenende.

Gruß
Michael

****************
Public Sub Verteilungneu()


loSpalteL = 11 ' Spalte "K" (Betrag) > muss angepasst werden wenn der Tabellenaufbau abweicht
loSpalteR = 15 ' Spalte "O" (Betrag) > muss angepasst werden wenn der Tabellenaufbau abweicht
loSpalteBL = loSpalteR + 2 ' Spalte "Q" (Haben-Kto) > muss angepasst werden wenn der Tabellenaufbau abweicht
loSpalteBR = loSpalteBL + 2 ' Spalte "T" (Soll-Kto) > muss angepasst werden wenn der Tabellenaufbau abweicht
loZeileR = 8 ' geht davon aus, dass die Werte in der 8. Zeile beginnen
loZeileBL = 8 ' geht davon aus, dass die Werte in der 8. Zeile beginnen
loZeileBR = 8 ' geht davon aus, dass die Werte in der 8. Zeile beginnen
loZeileTry = 8 ' geht davon aus, dass die Werte in der 8. Zeile beginnen

With Me
' erstmal die Reste vom letzten Durchlauf löschen
.Columns(loSpalteL + 1).EntireColumn.Clear
.Range(.Columns(loSpalteR + 1).EntireColumn, .Columns(loSpalteBR + 1).EntireColumn).Clear
' letzte benutzte Zeile = Zeile mit den Gesamtsummen der Konten (wenn unterhalb noch etwas im Blatt steht, muss hier eventuell angepasst werden)
loLetzteZeile = .Cells(.Rows.Count, loSpalteL).End(xlUp).Row
' Überschriften eintragen
.Cells(loLetzteZeile, loSpalteR + 1).FormulaR1C1 = "=SUM(R2C" & loSpalteR + 1 & ":R" & loLetzteZeile - 1 & "c" & loSpalteR + 1 & ")"
.Cells(loLetzteZeile, loSpalteL + 1).FormulaR1C1 = "=SUM(R2C" & loSpalteL + 1 & ":R" & loLetzteZeile - 1 & "c" & loSpalteL + 1 & ")"
.Cells(1, loSpalteBL) = "Haben-Kto"
.Cells(1, loSpalteBL + 1) = "Haben-Betrag"
.Cells(1, loSpalteBR) = "Soll-Kto"
.Cells(1, loSpalteBR + 1) = "Soll-Betrag"
' Beträge (positiv) in die Spalte rechts neben den Beträgen als Hilfsspalte eintragen
For loZeile = 2 To loLetzteZeile - 1
.Cells(loZeile, loSpalteR + 1) = .Cells(loZeile, loSpalteR)
.Cells(loZeile, loSpalteL + 1) = .Cells(loZeile, loSpalteL) * (-1)
Next loZeile
' Schleife bis komplette Tabelle abgearbeitet
Do Until loZeileR >= loLetzteZeile - 1
' immer 4 Beträge aus der rechten Auflistung bearbeiten
loCountR = 0
dblSumR = 0
For loZeile = loZeileR To loLetzteZeile - 1
loZeileR = loZeile
If .Cells(loZeileR, loSpalteR + 1) > 0 Then
dblSumR = dblSumR + .Cells(loZeileR, loSpalteR + 1)
.Cells(loZeileBR, loSpalteBR) = .Cells(loZeileR, loSpalteR - 1)
.Cells(loZeileBR, loSpalteBR + 1) = .Cells(loZeileR, loSpalteR)
loZeileBR = loZeileBR + 1
loCountR = loCountR + 1
.Cells(loZeileR, loSpalteR + 1) = 0
If loCountR = 4 Then Exit For
End If
Next loZeile
' bis zu 4 Beträge aus der linken Auflistung bearbeiten, solange versuchen bis es passt
NextTry:
Erase strArray()
loCountL = 0
dblSumL = 0
For loZeile = loZeileTry To loLetzteZeile - 1
If .Cells(loZeile, loSpalteL + 1) > 0 Then
dblSumL = dblSumL + .Cells(loZeile, loSpalteL + 1)
loCountL = loCountL + 1
strArray(loCountL) = .Cells(loZeile, loSpalteL + 1).Row
If dblSumL >= dblSumR Then Exit For
If loCountL = 4 Then Exit For
End If
Next loZeile
If dblSumL < dblSumR Then
loZeileTry = loZeileTry + 1
If Not loZeileTry >= loLetzteZeile Then
GoTo NextTry ' neuer Versuch wenns nicht passt
Else
MsgBox "In der linken Tabelle konnten keine passenden Werte gefunden werden." & vbNewLine _
& "Bitte die Kontenauflistung überprüfen.", , "Abbruch wegen Summenfehler!"
End If
Else
loZeileTry = 2
End If
' Werte in Buchungsblöcke übernehmen
' wenn Vergleich zwischen Soll & Haben nicht aufgeht, dann Beträge anpassen
For loCountArr = 1 To loCountL
If strArray(loCountArr) > 0 Then
.Cells(loZeileBL, loSpalteBL) = .Cells(strArray(loCountArr), loSpalteL - 1)
.Cells(loZeileBL, loSpalteBL + 1) = .Cells(strArray(loCountArr), loSpalteL + 1)
.Cells(strArray(loCountArr), loSpalteL + 1) = 0
loZeileBL = loZeileBL + 1
End If
Next loCountArr
If dblSumL >= dblSumR Then
.Cells(strArray(loCountL), loSpalteL + 1) = dblSumL - dblSumR
.Cells(loZeileBL - 1, loSpalteBL + 1) = .Cells(loZeileBL - 1, loSpalteBL + 1) - .Cells(strArray(loCountL), loSpalteL + 1)
End If
' Leerzeile zwischen den Buchungsblöcken
loZeileBR = loZeileBR + 1
loZeileBL = loZeileBR
' Schleife beenden wenn keine passenden Werte gefunden wurden
If loZeileTry >= loLetzteZeile Then Exit Do
Loop ' Schleifenende
' Kontrollsumme unter den Buchungsblöcken
.Cells(loZeileBR + 1, loSpalteBR + 1).FormulaR1C1 = "=SUM(R2C" & loSpalteBR + 1 & ":R" & loZeileBR - 1 & "c" & loSpalteBR + 1 & ")"
.Cells(loZeileBL + 1, loSpalteBL + 1).FormulaR1C1 = "=SUM(R2C" & loSpalteBL + 1 & ":R" & loZeileBL - 1 & "c" & loSpalteBL + 1 & ")"
' Summe der Buchungsplöcke kontrollieren und Werte in Hilfsspalten löschen
If .Cells(loZeileBR + 1, loSpalteBR + 1).Text = .Cells(loZeileBL + 1, loSpalteBL + 1).Text Then
.Columns(loSpalteL + 1).EntireColumn.Clear
.Columns(loSpalteR + 1).EntireColumn.Clear
Else
MsgBox "Bitte die Buchungsblöcke überprüfen.", , "Summenfehler!"
End If
End With
End Sub

*****************************

 

Hallo Michael,

freut mich das es prinzipiell für Dich passt.
Wie gesagt, nicht alle möglichen Zahlenkonstellationen sind abgedeckt.
Ich habe auch nochmal ein wenig darüber nachgedacht wie sich sowas umsetzen ließe.
Hinbekommen würde ich es vermutlich, und reizen würde es mich auch (interessante Herausforderung), aber dafür habe ich momentan nicht die Zeit.


Zu Deiner Anpassung:
Dies ist ein klassisches Beispiel warum es immer am besten ist, bei Fragestellungen den original Tabellenaufbau zu verwenden.
Das spart dem Hilfesuchenden die Anpasserei hinterher, und den Helfenden ebenfalls die Nacharbeit.

Ich habe Dir den Code jetzt auf die von Dir gewünschten Zeilen und Spalten angepasst.
Um eine eventuelle zukünftige Änderung zu erleichtern, habe ich für die erste Zeile mit Werten eine Variable definiert und diese überall anstatt von Zahlen benutzt.
Falls Du nochmal den Bereich (die Spalten) veränderst, lass den Code im Einzelschrittmodus durchlaufen und kontrolliere immer wieder die Bezüge, dann siehst Du wo eine Änderung nötig wird.

Die Suche nach der letzten benutzten Zeile habe ich angepasst und leicht verändert.
Nun wird nach der letzten Kto-Nr der linken Tabelle gesucht. In dieser Spalte sollte also nichts mehr darunter stehen. Dadurch wurden dann einige kleinere Anpassungen im restlichen Code nötig.

Die Buchungsblock-Spalten werden jetzt auch formatiert.

Den Anhang Michael Vers3.xls betrachten

Ich hoffe geholfen zu haben.


PS:
So kompliziert ist das Makro eigentlich nicht, aber es sieht so aus, da gebe ich Dir Recht.
Schau Dir doch einfach mal im Einzelschrittmodus genau an was passiert, und versuche erst die jeweilige Codezeile zu verstehen, bevor Du weiter klickst.

 

Halle Achim,

danke für Deine Hilfe, ich hoffe ich nerve Dich nicht. Ich hatte jetzt noch ein kleines Problem mit der Fehlermeldung 400, aber das lag an meiner Formatierung, nachdem ich die geändert habe, funkioniert es.

Habe mir das mal im Einzelbildmodul angesehen. Sehr interessant ... und auch irgendwie verständlich :-)
Gruß Michael

 

Hallo Michael,

keine Sorge, Du nervst nicht.
Wenn mich sowas nerven würde, dann wäre ich hier definitiv fehl am Platze.

Es ist halt einfach nur ein typisches, immer wiederkehrendes Muster:
Eine Frage wird gestellt, eine Lösung erarbeitet, und dann kommt das "Ja, aber... in meiner Original-Datei sieht alles ganz anders aus, ich brauche Hilfe bei der Anpassung..."
Das ist jetzt nicht böse gegen Dich gemeint (auch wenn es sich vielleicht so liest), aber dadurch wird in vermutlich allen Foren eine Unmenge an Zeit, Energie, Kreativität und Hilfsbereitschaft gebunden und verplempert. Und das eigentlich völlig unnötig, vor allem da die Helfenden ja normalerweise alles in Ihrer Freizeit machen.

Und je öfter das erwähnt wird, umso öfter wird es gelesen, und umso größer ist die Chance, dass der nächste Fragesteller sich vor der Frage ein wenig Gedanken macht, wie so eine Fragestellung aussehen kann um wirklich Sinn zu machen.

Wie gesagt, ist nicht böse gegen Dich, ab und an muss es einfach mal wieder erwähnt werden.