VBA: Verteilung von Werten nach Datumsabgleich

[Josch]

Hallo liebe Forenmitglieder,

ich bin schon etwas länger als stiller Beobachter dabei und habe hier schon einige gute Tipps gefunden. Dabei waren auch ein paar sehr grundlegende VBA-Makros, aber so richtig verstanden habe ich die Materie leider noch nicht. Ich wende mich also zum ersten Mal aktiv an euch Spezialisten und hoffe, dass ihr mir helfen könnt. Mein Problem ist folgendes:

Ich habe eine Tabelle mit diversen Zahlungen, den jeweiligen Beträgen und zwei Daten: dem Zahlungsziel und der tatsächlichen Zahlung.
Dahinter habe ich eine Tabelle mit allen Daten vom 01.01.18 bis zum 31.12.18.


Tabellenkopf in Zeile 6:         [G] Betrag  |  [H] Zahlungsziel  |  [I] tatsächliche Zahlung  |  [J] 01.01.18  |  [K] 02.01.18  |  [L] 03.01.18  |  …

1. Zahlung in Zeile 7:...



Ich möchte, dass die Beträge auf die jeweiligen Kalendertage verteilt werden und zwar auf den Tag "Zahlungsziel", wenn kein Eintrag in "tatsächliche Zahlung" vorliegt und am Tag "tatsächliche Zahlung", wenn das Feld ausgefüllt ist. Ohne VBA-Programmierung lautet meine Formel für die 1. Zelle im Kalenderbereich (Zelle J7)

=WENN(UND(J$6=$H7;$I7="");$G7;WENN(J$6=$I7;$G7;""))

Da in diesem Fall aber alle Zellen im Kalenderbereich belegt sind und dies einige Nachteile mit sich bringt, würde ich dies gern mit Hilfe eines Makros umsetzen. Ich habe meine Datei angehängt, falls das hilft. Kann mir vielleicht jemand helfen?

Vielen Dank im Voraus.

Besten Gruß

[WillWissen]

Moin,

das mit dem Hochladen der Datei hat nicht ganz geklappt - nach dem "Durchsuchen" musst du auch den Button (rechts) "Attachment hinzufügen" anklicken.

[schauan]

Hallöchen,

man könnte das so lösen. Der Code kommt in das Tabellenblattmodul wo die Daten verarbeitet werden. Den VBA-Editor kennst Du?
Der Code könnte noch auf einen Zeilenbereich eingeschränkt werden - für die Spalten ist es schon drin:
If Target.Column <> 8 And Target.Column <> 9 Then Exit Sub
Wenn Du in Spalte H oder I die Überschriften änderst, läuft er in einen Fehler ..

Private Sub Worksheet_Change(ByVal Target As Range)
'Wenn kein Eintrag in SPalte 8 oder 9, dann Makro verlassen
If Target.Column <> 8 And Target.Column <> 9 Then Exit Sub
'Events deaktivieren
Application.EnableEvents = False
'Startzahl f?r 1.1.2018 - koennte man auch mit cdbl ermitteln ...
Const lStart = 43101
'Zeile ab Spalte J leeren
Cells(Target.Row, 10).Resize(1, 366) = ""
'Wenn in H was steht, dann Betrag bei Datum von H eintragen
If Cells(Target.Row, 8).Value Then Cells(Target.Row, CDbl(Target.Value) - lStart + 10) = Cells(Target.Row, 7).Value
'Wenn in I was staht, dann
If Cells(Target.Row, 9).Value Then
'erst mal den von H erzeugten Eintrag entfernen
Cells(Target.Row, CDbl(Target.Offset(0, -1).Value) - lStart + 10) = ""
'Betrag bei Datum von I eintragen
Cells(Target.Row, CDbl(Target.Value) - lStart + 10) = Cells(Target.Row, 7).Value
'Ende Wenn in I was staht, dann
End If
'Events deaktivieren
Application.EnableEvents = True
End Sub

[Josch]

Vielen Dank für die schnellen Antworten.

Ich habe den Code entsprechend übernommen und es funktioniert soweit wie ich mir das vorgestellt habe. (Datei als Anlage, diesmal hoffentlich wirklich auch dabei).

Leider treten noch in folgenden Fällen Fehlermeldungen (Lauftzeitfehler 1004) auf:
- Ein Datum für "tatsächliche Zahlung" wird definiert, ohne dass ein "Zahlungsziel" angegeben wurde
- Ein Datum für "tatsächliche Zahlung" wird gelöscht 
- Ein Datum für "Zahlungsziel" wird gelöscht (nur, wenn auch ein Datum unter "tatsächliche Zahlung" bereits definiert ist)

Ein paar andere Fehlermeldungen konnte ich durch festlegen von Gültigkeitskriterien bereits unterdrücken (Betrag muss vor Datum festgelegt werden).

Last but not least wäre es super, wenn das Makro auch auslösen würde, sobald der Betrag geändert wird. Dies könnte theoretisch auch über einen Klick auf einen Button ausgelöst werden.

Für jede Hilfe wäre ich sehr dankbar.

MfG
Josch

[schauan]

Hallo Josch,

erst mal was zur Reihenfolge der Eintragungen. Der Code geht davon aus, dass ein Zahlungsziel vorhanden ist. Das kann man da sehen:

'Wenn in I was steht, dann
If Cells(Target.Row, 9).Value Then
'erst mal den von H erzeugten Eintrag entfernen

Du müsstest dann noch eine Bedingung einfügen, die auf einen Eintrag in H prüft. Der codeteil sieht dann so aus:

'Wenn in I was steht, dann
If Cells(Target.Row, 9).Value Then
'erst mal den von H erzeugten Eintrag entfernen
'Wenn in H was steht, dann
If Cells(Target.Row, 8).Value Then
Cells(Target.Row, CDbl(Target.Offset(0, -1).Value) - lStart + 10) = ""
'Betrag bei Datum von I eintragen
Cells(Target.Row, CDbl(Target.Value) - lStart + 10) = Cells(Target.Row, 7).Value
'Ende Wenn in H was steht, dann
End If
'Ende Wenn in I was steht, dann
End If

Das mit dem Löschen schaue ich mir noch an. Wenn der Code im Codemodul des Tabellenblattes steht, sollte er bei Änderungen ausgeführt werden. Ich vermute, Du hast mal bei einem Fehler abgebrochen. Am Anfang des Codes wird die Reaktion auf Events ausgeschalten. Durch den Abbruch wurde sie nicht wieder eingeschalten.

Du müsstest dazu entweder Excel neu starten oder mal dieses kleine Makro:

Code:

Private Sub RestartEvents()
'Events aktivieren
Application.EnableEvents = True
End Sub

[Josch]

Hallo schauan,

tatsächlich wurden dadurch ein paar Fehler ausgeschlossen.
Damit verbleiben leider noch 3 Probleme:

- Leider aktualisieren sich die verteilten Werte nicht automatisch, wenn der Betrag geändert wird (es muss zuerst das aktuellere Datum erneut eingegeben werden).
- Ohne "Zahlungsziel" wird auch die "tatsächliche Zahlung" nicht verteilt
- Das Datum der "tatsächlichen Zahlung" kann nicht ohne Fehlermeldung gelöscht werden, ohne zunächst das "Zahlungsziel" zu löschen

Ich versuche mich selbst z.Z. an einer Lösung, aber jede Hilfe ist natürlich willkommen.

Danke :)

[schauan]

Hallöchen,

hier mal wieder ein kompletter Code. Ich hab jetzt noch die Spalte G einbezogen, eine kleine Fehlerbehandlung und ein paar andere kleine Korrekturen.

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
'Wenn kein Eintrag in SPalte 8 oder 9, dann Makro verlassen
If Target.Column <> 7 And Target.Column <> 8 And Target.Column <> 9 Then Exit Sub
'Gehe bei Fehler zur Fehlerbehandlung
On Error GoTo errorhandler
'Events deaktivieren
Application.EnableEvents = False
'Startzahl fuer 1.1.2018 - koennte man auch mit cdbl ermitteln ...
Const lStart = 43101
'Zeile ab Spalte J leeren
Cells(Target.Row, 10).Resize(1, 366) = ""
'Wenn in H was steht, dann Betrag bei Datum von H eintragen
If Cells(Target.Row, 8).Value Then Cells(Target.Row, CDbl(Cells(Target.Row, 8).Value) - lStart + 10) = Cells(Target.Row, 7).Value
'Wenn in I was steht, dann
If Cells(Target.Row, 9).Value Then
    'erst mal den von H erzeugten Eintrag entfernen
    'Wenn in H was steht, dann
    If Cells(Target.Row, 8).Value Then
        Cells(Target.Row, CDbl(Cells(Target.Row, 8).Value) - lStart + 10) = ""
    'Ende Wenn in H was steht, dann
    End If
    'Betrag bei Datum von I eintragen
    Cells(Target.Row, CDbl(Cells(Target.Row, 9).Value) - lStart + 10) = Cells(Target.Row, 7).Value
'Ende Wenn in I was steht, dann
End If
errorhandler:
'Events deaktivieren
Application.EnableEvents = True
'Ausgabe einer Fehlermeldung bei Bedarf
If Err Then MsgBox "Fehler: " & Err.Number & vbLf & Err.Description
End Sub

[Josch]

Großartig, tut genau das, was es soll!
 
Vielen Dank!