Abzug Wert über mehrere Zellen

[Zofomuko]

Hallo zusammen,

ich stehe auf dem Schlauch.

Ich habe eine Mappe mit 9 Tabellenblättern. Die Tabellenblätter sind per Passwort geschützt.
Auf Tabellenblatt 2 bis 9 soll eine Subtraktion stattfinden.
Auf jedem Tabellenblatt soll in Spalte "D" ein Wert eingetragen werden können. Dieser Wert soll dann in der entsprechenden Zeile je Spalten"E" bis "R" abgezogen werden nach folgendem Prinzip: Wert "e"- Wert "D". Wenn "D" > "E", dann "E"=0 und Differenz "D"und "E" von "F" abziehen, usw.
Dies geht über 230 Zeilen für jede Zeile extra.

Beispiel:

Zeile 4: Wert in "d4"= 50 ;Wert in "E4"= 40; wert in "F4"= 30
Daraus folgt: "E" = 0, "F" = 20
Zeile 5: Wert in "D5" = 60; Wert in "E5"= 80
Daraus folgt: Wert in "E5" =20
usw.


Ausgelöst werden soll dass nach Klick auf eine Schaltfläche.
Die Schaltfläche soll auf jedem Tabellenblatt vorhanden sein.

Wo liegt im Code der Fehler bzw. geht es einfacher?

Bin für jede Hilfe dankbar.

Gruß
Zofomuko

Code:

Option Explicit

    Sub ReCalcOvertime()
    Dim rng As Range
    Dim rngAbgbH As Range, rngMon As Range
    Dim iMon As Integer

    For Each rng In Columns.Worksheet.UsedRange.Rows

    
    Set rngAbgbH = rng.Cells(4, 4) ' reducing overtime
    If IsNumeric(rngAbgbH) Then
    For iMon = 4 To 18
    Set rngMon = rng.Cells(4, 4 + iMon)
    If rngAbgbH.Value >= rngMon.Value Then
    rngAbgbH.Value = rngAbgbH.Value - rngMon.Value
    rngMon.Value = 0
    Else
    rngMon.Value = rngMon.Value - rngAbgbH.Value
    rngAbgbH.Value = 0
    End If
    If rngMon.Value = 0 Then
    rngMon.ClearContents
    End If
    If rngAbgbH.Value = 0 Then
    rngAbgbH.ClearContents
    Exit For
    End If
    Next
    End If
    Next
    End Sub

[Elex]

Hey,

dein Vorhaben ist mir (mangels Antworten denke ich uns) leider noch nicht ausreichend dargelegt.

Dieser Wert soll dann in der entsprechenden Zeile je Spalten"E" bis "R" abgezogen werden nach folgendem Prinzip: Wert "e"- Wert "D". Wenn "D" > "E", dann "E"=0 und Differenz "D"und "E" von "F" abziehen, usw.

Wie setzt sich die logig bis "R" fort, gilt für G-R das gleiche wie für F?

Welchen Wert bekommt F hier:
Zeile 5: Wert in "D5" = 60; Wert in "E5"= 80
Daraus folgt: Wert in "E5" =20

Mfg

[BoskoBiati]

Hi,

versuche mal das:

Code:

Sub test()
Dim arrWerte As Variant
Dim loSum As Long
Dim loQ As Long
Dim loCo As Long
Dim bol As Boolean

bol = False
loQ = Cells(4, 4)

For loCo = 1 To 18
    arrWerte = arrWerte & "," & Cells(4, 4 + loCo)
Next
    For loCo = 5 To 23
        loSum = WorksheetFunction.Sum(Range(Cells(4, 5), Cells(4, loCo)))
        If loSum <= loQ Then
            loQ = loQ - Cells(4, loCo)
            Cells(4, loCo) = 0
        Else
            Cells(4, loCo) = Cells(4, loCo) - loQ
            bol = True
        End If
        If bol = True Then Exit Sub
    Next
End Sub

[Zofomuko]

Hallo,

@Opa Edgar

Danke, ich werde das morgen versuchen und dann Rückmeldung geben.

Aber kannst du mir den Fehler in meinem Code nennen?
Wenn ich weiß, wo mein Fehler liegt, kann ich daraus lernen.

@Elex

Genauere Projektbeschreibung:

Es geht um Überstunden.
Jede Abteilung hat ein eigenes Tabellenblatt (Tabellenblatt 3-9), Tabellenblatt 1 öffnet nach Passwortabfrage das zugehörige Tabellenblatt, ein Button auf jeder Tabellenseite verbirgt das Tabellenblatt wieder, Tabellenblatt 2 ist die Gesamtsicht des Chefs über alle Abteilungen. Er kann also alle Tabellenblätter öffnen, die Überstunden aller importieren und alle Tabellenblätter wieder schließen.


In Spalte A stehen die Nachnamen, in Spalte B die Vornamen, in Spalte C die Abteilungskürzel, in Spalte D sollen abgebaute Überstunden eingetragen werden, in Spalte E stehen Überstunden des Vorjahres, in F-R stehen die entstandenen Überstunden des aktuellen Jahres in speziellen Abrechungszeiträumen. Jede Abteilung hat mindestens 30 Mitarbeiter, also mind. 30 Zeilen.
Wenn nun der Abteilungsleiter abgebaute Überstunden einträgt, sollen sie (per Button Druck) von den vorhandenen Überstunden abgezogen werden, jeweils beginnend mit den ältesten Überstunden.
Wenn Mitarbeiter Mustermann also Überstunden abgebaut hat (z.B. durch Freischichten), trägt der Abteilungsleiter sie in Spalte D ein, die ältesten Überstunden stehen in Spalte E. Also muss erst Spalte E  auf Null herunterlaufen, dann Spalte F usw. bis alls Überstunden abgebaut sind.

Ist meine Beschrreibung verständlich?


Grüße
Zofomuko

[BoskoBiati]

Hi,

diese Vorgehensweise macht aber nur dann Sinn, wenn Überstunden ein Verfallsdatum haben und auch darauf geachtet wird. Deinen Code habe ich mir nicht angeschaut, weil das Erstellen des Neuen in zwei Minuten erledigt war, während es sicher deutlich länger gedauert hätte, Deinen zu verstehen. Allerdings ist mir gerade aufgefallen, dass ich ein Array gebildet habe, ohne es zu nutzen. Da muss ich nochmal drüber sehen, was da passiert.

[Elex]

Hey

Ich versteh es nun so das wenn E =10 F = 20 G =20  H =10 und D = 55
dann wird daraus E = 0  F = 0  G = 0 und H = 5

Mfg

[Elex]

und hier der Code:

Code:

Option Explicit
Dim LeZe As Long
Dim n As Integer
Dim i As Integer
Dim Dneu As Integer

Private Sub ????()

LeZe = ThisWorkbook.Worksheets("Abt").Cells(Rows.Count, 4).End(xlUp).Row

For n = 4 To LeZe 'Zeilen
    Dneu = Cells(n, 4)
        For i = 5 To 18 ' Spalten E bis R
            If Dneu <= Cells(n, i) Then
               Cells(n, i) = Cells(n, i) - Dneu
               Dneu = 0
            Else
               Dneu = Dneu - Cells(n, i)
               Cells(n, i) = 0
            End If
        Next i
        Cells(n, 4) = 0
Next n

End Sub

Wenn es so ist, dass R am Ende auch negativ werden soll/kann muß das noch in den Code übernommen werden.

[Zofomuko]

Hallo,

@Opa Edgar
ja, die Zellen aus Januar 17 werden im Januar 18 genullt.

@Elex

Nein,

wenn D= 50, E=20 F=20 und G=20 sind,
ist das Ergebnis:
E=0, F=0, G=10



Vielen Dank, ich werde es testen und Rückmelden.
Zofomuko

[Elex]

Das habe ich auch nicht behauptet.

wenn D= 50, E=20 F=20 und G=20 sind,
ist das Ergebnis:
E=0, F=0, G=10

bitte noch einmal lesen!

[Elex]

wenn R negativ werden kann

Code:

Option Explicit
Dim LeZe As Long
Dim n As Integer
Dim i As Integer
Dim Dneu As Integer

Private Sub ????()

LeZe = ThisWorkbook.Worksheets("Abt").Cells(Rows.Count, 4).End(xlUp).Row

For n = 4 To LeZe 'Zeilen
    Dneu = Cells(n, 4)
        For i = 5 To 18 ' Spalten E bis R
            If Dneu <= Cells(n, i) Then
               Cells(n, i) = Cells(n, i) - Dneu
               Dneu = 0
            Else
               If i = 18 Then
               Cells(n, i) = Cells(n, i) - Dneu
               Else
               Dneu = Dneu - Cells(n, i)
               Cells(n, i) = 0
               End If
            End If
        Next i
        Cells(n, 4) = 0
Next n

End Sub

Im den beiden Codes mußt du noch für Worksheets("Abt") deinen Blattnamen eintragen.