Clever-Excel-Forum

Seiten: 1 2

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.

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
[attachment=49488]

Gruß Uwe

Guten Morgen Uwe,

zunächst einmal vielen Dank für Deine Mühe.

Das übergeben der werte klappt richtig gut...

Einige Fragen habe ich noch.

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.

Gruß Sven

Hallo Sven,

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.

Gruß Uw

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

Code:
If Tabelle1.Cells(i, j) .Interior.Color = 11854022 Then

    Tabelle1.Cells(i, j) = Tabelle1.Cells(i, j).value + Format(CDbl(Cells(iZeile, 3)), "#,##0.00 €")

    Tabelle1.Cells(i, j).NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)"

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

Ja.
Man kann, da hier schon die Formatierung vorhanden ist, es etwas vereinfachen:

Code:
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

Gruß Uwe

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.

Gruß Uwe

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

Seiten: 1 2

sveni_lee

Egon12

sveni_lee

Egon12

sveni_lee

Egon12

sveni_lee

Egon12

sveni_lee

sveni_lee