31.08.2020, 14:56 (Dieser Beitrag wurde zuletzt bearbeitet: 31.08.2020, 15:04 von Goldhexe.)
Hallo Excel Profis,
ich bin auf der Suche nach einer Formel die Zellen durchforstet, und wenn in Spalte bei MwSt 5% ein Betrag steht und einer steht bei der Spalte 16% das Excel einen neue Zeile generiert, in dieser dann einen Betrag der Spalte reinschreibt bzw. verschiebt und dann noch den Gesamtbetrag aufteilt. Wäre das Super..
Und als Schmankerl unten die Beträge alle auflistet.
das Einfügen der Zeilen lässt sich nur per VBA realisieren. Man geht die Tabelle von unten nach oben durch und wenn in beiden Spalten eine Zahl >0 steht dann fügt man eine Zeile ein und verteilt die Daten wie auf dem Bild 2 zu sehen ist. Schauen wir mal
. \\\|/// Hoffe, geholfen zu haben. ( ô ô ) Grüße, André aus G in T ooO-(_)-Ooo (Excel 97-2019+365)
Der Code sucht am Anfang im Bereich C1 bis F100 wo die Überschrift mit den 5% steht - könnte man auch fest programmieren - und darauf aufbauend wird dann der Rest erledigt. Wenn Du, wie Günter schreibt, da schon einiges mit Formeln berechnest klappt das hinterher vielleicht auch noch
Code:
Sub test()
'Variablendeklarationen
Dim gefunden, lLRow&, iCnt%
'Zelle mit ... 5% suchen
Set gefunden = ActiveSheet.Range("C1:F100").Find(What:="MwSt. (5.0%)", After:=Range("C1")) ', LookAt:=xlValues, LookIn:=xlWhole)
'Letzte Zeile anhand Quittungsnummer ermitteln
lLRow = gefunden.Offset(0, -1).End(xlDown).Row
'Schleife von unten nach oben
For iCnt = lLRow To gefunden.Row + 1 Step -1
'Mit der Zelle als Ausgangspunkt
With Cells(iCnt, gefunden.Column)
'Wenn hier und daneben Werte > 0 stehen, dann
If .Value > 0 And .Offset(0, 1).Value > 0 Then
'Zeile darunter einfuegen
Rows(iCnt + 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
'5% Wert 1 tiefer uebernehmen
.Offset(1, 0).Value = .Value
'5% Wert auf 0 setzen
.Value = 0
'Eingabeart uebernehmen
.Offset(1, 5).Value = .Offset(0, 5).Value
'Differenzbetrag ermitteln und eintragen
.Offset(1, 2).Value = .Offset(0, 3).Value + .Offset(0, 4).Value - .Offset(0, 2).Value
'Ende Wenn hier und daneben Werte > 0 stehen, dann
End If
'Ende Mit der Zelle als Ausgangspunkt
End With
'Ende Schleife von unten nach oben
Next
End Sub
. \\\|/// Hoffe, geholfen zu haben. ( ô ô ) Grüße, André aus G in T ooO-(_)-Ooo (Excel 97-2019+365)