nachdem ich es nun mit eurer Hilfe geschafft habe, Summen nach hintergrundfarbe zu bilden möchte ich nun einen Schritt weiter gehen.
Unser Neubau (EFH) wird aus verschiedenen Töpfen gespeist. Ich möchte nun gern einen Überblick behalten wo wir zu jeder Zeit finanziel stehen. Ich habe nun eine Tabelle mit Soll/Ist vergleich und einer Fälligkeitsübersicht nach Monaten.
Wenn ich nun Zahlungen tätige, sollen diese den entsprechenden Kosten-Kategorien und Töpfen zugeordnet werden.
Dazu habe ich folgenden Ablaufplan für ein VBA Programmierung
PHP-Code:
Eingabe der Zahlung unter Daten umwandeln "bezahlt" in Format [mmm jj] suche in Tabelle "Tabelle1" nach [Unterkategorie] in "Spalte B"
vorhanden: suche nach Datum [mmm jj] in "Zeile 1"
vorhanden: Überprüfung ob Zelle grüner Hintergrund ja: Addierung zellenwert + Eingabewert "Betrag" nein: überschreiben Wert in Zelle mit Eingabewert "Betrag" setzten des Hintergrund auf Farbe grün
nicht vorhanden: Fehler
nicht vorhanden: suchen nach [Kategorie] in "Spalte A"
vorhanden: Überprüfung ob Zelle grüner Hintergrund ja: Addierung zellenwert + Eingabewert "Betrag" nein: überschreiben Wert in Zelle mit Eingabewert "Betrag" setzten des Hintergrund auf Farbe grün
nicht vorhanden: Fehler
Ende
würde dies so möglich sein?
Als Java-script oder in Pyton würde ich eventuell hinbekommen aber für VBA fehlt mir jegliche Erfahrung.
ich habe mal eine Beispiel-Datei die von @HKindler erstellt wurde überarbeitet.
17.09.2023, 20:42 (Dieser Beitrag wurde zuletzt bearbeitet: 17.09.2023, 20:42 von Egon12.)
Hallo,
anbei mal der nächste Schritt. Es wird der Tilgungsbetrag an die gesuchte Zielzelle übergeben. Die Dropdowns habe ich auch aufgeräumt und abhängig gemacht zwecks Fehlervermeidung in der Übergabe in die korrekte Zelle der Tabelle1. Die Auswertung, ob das Zahlungsziel erreicht ist, wäre dann dein nächster Schritt. Ein kleiner Hinweis, was die Funktion Farbsumme betrifft: Die Zellfarbe muss vor der Eingabe des Wertes in der Zelle passieren, sonst scheitert logischerweise die Übergabe des Rückgabewertes aus der Funktion. Der Wert von .Interior.Color ist 11854022
Wenn die "Zielzelle" einen grünen Hintergrund hat, sollen der Wert der in der Zelle steht und der "neue" Wert addiert werden.
Wenn die "Zielzelle" keinen grünen Hintergrund hat, kann dann der darinstehende Wert gelöscht werden, anschließend die "Zielzelle" grün hinterlegt werden und dann der Wert eingetragen werden?
Kann man die Daten-Tabelle dynamisch gestalten, so das ein neuer Eintrag in dere nächsten Zeile möglich ist.
zu 1. und 2. Da braucht es nur eine If/Else Abfrage wie in Phyton o. Ä., ob die Zelle grün ist.
zu 3. die Tabelle ist dynamisch. Wenn du einen neuen Eintrag eingeben willst, nimmst du da einfach die nächste leere Zeile, trägst die Summe ein und die Tabelle pflanzt sich mit allen Formeln und DropDowns fort.
Versuche es erstmal selbst diese Abfrage einzubauen. Helfen kann man später immer noch.
18.09.2023, 10:26 (Dieser Beitrag wurde zuletzt bearbeitet: 18.09.2023, 10:41 von sveni_lee.)
okay...
dann versuche ich mal...
Wenn ich es richtig verstanden habe, wird die Zelle in die geschrieben wird an dieser Stelle eindeutig identifiziert.
Code:
Set rngKat = Tabelle1.Columns(1).Find(Cells(iZeile, 1)) If Not rngKat Is Nothing Then For i = rngKat.Row + 1 To Tabelle1.Cells(Rows.Count, 1).End(xlUp).Row If Tabelle1.Cells(i, 1) <> rngKat.Value2 And Tabelle1.Cells(i, 1) <> "" Then lz = i - 1 Exit For End If Next i End If
und hier dann Formariert und an die Zelle übergeben.
Code:
For i = rngKat.Row To lz If Tabelle1.Cells(i, 2) = Cells(iZeile, 2) Then For j = 5 To Tabelle1.Cells(1, Columns.Count).End(xlToLeft).Column If Format(Cells(iZeile, 4), "mmm yy") = Format(Tabelle1.Cells(1, j), "mmm yy") Then Tabelle1.Cells(i, j) = Format(CDbl(Cells(iZeile, 3)), "#,##0.00 €") Tabelle1.Cells(i, j).NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)" End If Next j End If Next i
ich würde hinter der If Format(Cells(iZeile, 4), "mmm yy") = Format(Tabelle1.Cells(1, j), "mmm yy") Then Abfrage die Abfrage nach dem Tellenhintergrund einbauen
Super... das klappt jetzt so wie ich mir das vorgestellt hatte...
Ich stelle mir grad die Frage ob es sinnvoll wäre, die Zahlungen in einer "Checkbox" abzufragen. Einen Button auf der Daten-Tabelle für neue Zahlung hinzufügen. Wenn man dann mit Pflichtangaben arbeitet sollte das auch gehen.?
Man kann es auf verschiedene Art und Weise tun. Wichtig ist, dass die korrekte Zeile der Datentabelle übergeben wird. Beachten muss man, dass in der Spalte "Unterkategorie" es auch mal keinen Wert geben wird.
Ich habe ein paar Tage damit gespielt. Alles klappt so wie es soll.
folgendes würde ich gern noch ändern.
Die Fehlermeldung "Eingabe... fehlt" würde ich gern entfernen und einfach direkt zu der entsprechednen Zelle springen. ich denke dazu muß folgende Zeile gelöscht werden
PHP-Code:
MsgBox "In Spalte " & arrKat(i - 1) & "fehlt der Eintrag", vbExclamation, "Fehlende Auswahl/Eintrag"
Beim zweiten habe ich keinen richtigen Ansatz Wenn eine Unterkategorie vorhanden ist, muß auch zwingend eine gewählt werden.
in der Datenauswahl wird das ja mit INDIREKT() gemacht aber wie geht das in VBA, INDIREKT(i-1) <>""?
mit ein wenig probieren habe ich es wohl hinbekommen...
Jetzt wird die Daten MataDaten Tabelle durchsucht und wenn eine Übereinstimmung in den Kategorien vorligt wird geschaut ob auch in Zeile2 der Kategorie etwas eingetragen ist.
Code:
Option Explicit
' Überprüfung auf Vollständigkeit der Tabelle und Übergabe der Rate in die korrekte Zielzelle Private Sub Worksheet_Change(ByVal Target As Range) Dim iZeile&: iZeile = Target.Cells.Row Dim arrKat(): arrKat = Array("Kategorie", "Unterkategorie", "Betrag", "bezahlt", "v. Konto", "Kapital") Dim i&, j&, k&, rngKat As Range, lz& Application.EnableEvents = False If Not Intersect(Target, ListObjects(1).DataBodyRange) Is Nothing Then For i = 1 To 6 If Cells(iZeile, i) = "" And i <> 2 Then 'MsgBox "In Spalte " & arrKat(i - 1) & "fehlt der Eintrag", vbExclamation, "Fehlende Auswahl/Eintrag"' Cells(iZeile, i).Select Application.EnableEvents = True Exit Sub ElseIf Cells(iZeile, i) = "" And i = 2 Then Set rngKat = Tabelle2.Columns(1).Find(Cells(iZeile, 1)) If Not rngKat Is Nothing Then For k = rngKat.Row To Tabelle2.Cells(Rows.Count, 1).End(xlUp).Row If Tabelle2.Cells(k, 1) = rngKat.Value2 And Tabelle1.Cells(k, 2) <> "" Then Cells(iZeile, i).Select Application.EnableEvents = True Exit Sub Exit For End If Next k End If End If Next i Set rngKat = Tabelle1.Columns(1).Find(Cells(iZeile, 1)) If Not rngKat Is Nothing Then For i = rngKat.Row + 1 To Tabelle1.Cells(Rows.Count, 1).End(xlUp).Row If Tabelle1.Cells(i, 1) <> rngKat.Value2 And Tabelle1.Cells(i, 1) <> "" Then lz = i - 1 Exit For End If Next i End If For i = rngKat.Row To lz If Tabelle1.Cells(i, 2) = Cells(iZeile, 2) Then For j = 5 To Tabelle1.Cells(1, Columns.Count).End(xlToLeft).Column If Format(Cells(iZeile, 4), "mmm yy") = Format(Tabelle1.Cells(1, j), "mmm yy") Then If Tabelle1.Cells(i, j).Interior.Color = 11854022 Then Tabelle1.Cells(i, j) = CDbl(Tabelle1.Cells(i, j)) + CDbl(Cells(iZeile, 3)) Else Tabelle1.Cells(i, j).Interior.Color = 11854022 Tabelle1.Cells(i, j) = Format(CDbl(Cells(iZeile, 3)), "#,##0.00 €") Tabelle1.Cells(i, j).NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)" End If End If Next j End If Next i End If Application.EnableEvents = True End Sub