Zahlung dem Fälligkeitsmonat zuordnen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

_|___A___|_____B_____|______C_______|________D________|
1|Betrag |Start |alle x Monate |für |
2| 500| 01.08.2004| 3|was auch immer |
3| 77| 01.05.2005| 1|Miete |
4| 1111| 01.03.2004| 12|Kfz-Versicherung |
5| 33000| 01.10.2005| |neues Auto |

Sub Ausgaben_in_Monate() Const vonJ = 2004, bisJ = 2007 Dim jj%, mm%, zz&, Ausg As Worksheet Set Ausg = ActiveSheet ' ------------------------------------------- neue Monatstabelle anlegen Worksheets.Add after:=Sheets(1) Range("A1:C1") = Split("Jahr Monat Summe") Rows(1).HorizontalAlignment = xlCenter Columns("A").HorizontalAlignment = xlCenter Columns("B").NumberFormat = "mmmm" zz = 1 For jj = vonJ To bisJ For mm = 1 To 12 zz = zz + 1 Cells(zz, 1) = jj Cells(zz, 2) = Format(DateSerial(jj, mm, 1), "MMMM") Next mm Next jj ' -------------------------------------- Ausgaben in Monatstab. addieren With Ausg zz = 1 While Not IsEmpty(.Cells(zz + 1, 1)) zz = zz + 1 mm = (Year(.Cells(zz, 2)) - vonJ) * 12 + Month(.Cells(zz, 2)) + 1 Cells(mm, 3) = Cells(mm, 3) + .Cells(zz, 1) If .Cells(zz, 3) > 0 Then mm = mm + .Cells(zz, 3) While Not IsEmpty(Cells(mm, 1)) Cells(mm, 3) = Cells(mm, 3) + .Cells(zz, 1) mm = mm + .Cells(zz, 3) Wend End If Wend End With End Sub

Hallo Bernd,
"Leider läuft das Makro bei mir nicht ganz fehlerfrei." ist wohl leicht untertrieben. Wenn(!) ich dich richtig verstehe, tut das Makro überhaupt nicht das, was du möchtest.
Der Grund dafür liegt wohl in einer ziemlich unklaren Aufgabenstellung. Unter "Ab Spalte D folgt eine Monatskalender. Hier soll der Betrag automatisch zugeordnet werden." konnte ich mir nichts Konkretes vorstellen. Ich habe deshalb einen Vorschlag gemacht, der auf keinen Fall vorhandene Daten überschreibt - indem das Makro alle Ausgaben auf einem neu erstellten Tabellenblatt macht.
Deinen Satz "Die Daten werden von einem Kalender zum Teil überschrieben" verstehe ich gar nicht. Welcher Kalender überschreibt genau welche Daten, zu welchem Teil?
Und "das neue Arbeitsblatt ist leer" kann nicht sein - jedenfalls nicht, wenn das Makro gerade gelaufen ist. Zumindest die Überschriften (Jahr, Monat, Summe) stehen in Zeile A, und darunter werden 4 * 12 = 48 Zeilen angelegt, in denen die Spalten A und B mit Jahren und Monaten belegt sind. Was siehst du, nachdem du das Makro gestartet hast und es seine Arbeit beendet hat - ein leeres Blatt?
Der Tabelle in deiner heutigen Antwort habe ich etwas mehr über den "Monatskalender" ab Spalte D entnommen. Er beginnt mit "Jan 05" und endet mit "März 05". Soll er vielleicht bis zum Jahresende 2005 gehen? Oder vielleicht bis Dez. 2006?
Könnte es sein, dass du gar nicht die Summe der Ausgaben pro Monat sehen möchtest, sondern alle einzelnen Beträge, die im jeweiligen Monat fällig sind? Wäre es da nicht ein Leichtes, eine periodische Ausgabe einige Male zu kopieren, die Fälligkeiten anzupassen und dann nach den Fälligkeiten zu sortieren? Dazu bräuchte es kein Makro.
Grüße von Erich aus Kamp-Lintfort

Sub Ausgaben_in_Monate1() Const vonJ = 2005, bisJ = 2015 Dim jj%, mm%, zz&, sp% ' ------------------------------------------------------ Zeile pro Monat merken Rows(1).HorizontalAlignment = xlCenter zz = 4 For jj = vonJ To bisJ For mm = 1 To 12 zz = zz + 1 Cells(1, zz) = 1 Next mm Next jj ' -------------------------------------------- Ausgaben in Monatstab. eintragen zz = 1 While Not IsEmpty(Cells(zz + 1, 1)) zz = zz + 1 sp = (Year(Cells(zz, 2)) - vonJ) * 12 + Month(Cells(zz, 2)) + 4 Cells(1, sp) = Cells(1, sp) + 1 Cells(Cells(1, sp), sp) = Cells(zz, 1) If Cells(zz, 3) > 0 Then sp = sp + Cells(zz, 3) While Not IsEmpty(Cells(1, sp)) Cells(1, sp) = Cells(1, sp) + 1 Cells(Cells(1, sp), sp) = Cells(zz, 1) sp = sp + Cells(zz, 3) Wend End If Wend ' ------------------------------------------------- Monate in Zeile 1 eintragen zz = 4 For jj = vonJ To bisJ For mm = 1 To 12 zz = zz + 1 Cells(1, zz).NumberFormatLocal = "MMM JJ" Cells(1, zz) = DateSerial(jj, mm, 1) Next mm Next jj End Sub

Sub Ausgaben_in_Monate2() Const vonJ = 2005, bisJ = 2015 Dim jj%, mm%, zz&, sp% ' ------------------------------------------------- Monate in Zeile 1 eintragen zz = 4 For jj = vonJ To bisJ For mm = 1 To 12 zz = zz + 1 Cells(1, zz).NumberFormatLocal = "MMM JJ" Cells(1, zz) = DateSerial(jj, mm, 1) Next mm Next jj ' -------------------------------------------- Ausgaben in Monatstab. eintragen zz = 1 While Not IsEmpty(Cells(zz + 1, 1)) zz = zz + 1 sp = (Year(Cells(zz, 2)) - vonJ) * 12 + Month(Cells(zz, 2)) + 4 Cells(zz, sp) = Cells(zz, 1) If Cells(zz, 3) > 0 Then sp = sp + Cells(zz, 3) While Not IsEmpty(Cells(1, sp)) Cells(zz, sp) = Cells(zz, 1) sp = sp + Cells(zz, 3) Wend End If Wend End Sub

Beliebteste Forumthreads (12 Monate)

Zahlung dem Fälligkeitsmonat zuordnen

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread