31.08.2020, 15:56 (Dieser Beitrag wurde zuletzt bearbeitet: 31.08.2020, 16: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)