Registriert seit: 15.08.2017
Version(en): 2010
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
Registriert seit: 16.08.2017
Version(en): 2007 / 2010 / Web
28.08.2017, 16:03
(Dieser Beitrag wurde zuletzt bearbeitet: 28.08.2017, 16:03 von Elex.)
Hey,
dein Vorhaben ist mir (mangels Antworten denke ich uns) leider noch nicht ausreichend dargelegt.
Zitat: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
Registriert seit: 13.04.2014
Version(en): 365, 2019
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
Gruß
Edgar
Meine Antworten sind freiwillig und ohne Gewähr!
Über Rückmeldungen würde ich mich freuen.
Registriert seit: 15.08.2017
Version(en): 2010
28.08.2017, 18:05
(Dieser Beitrag wurde zuletzt bearbeitet: 28.08.2017, 18:05 von Zofomuko.
Bearbeitungsgrund: Ergänzung
)
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
Registriert seit: 13.04.2014
Version(en): 365, 2019
28.08.2017, 18:18
(Dieser Beitrag wurde zuletzt bearbeitet: 28.08.2017, 18:18 von 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.
Gruß
Edgar
Meine Antworten sind freiwillig und ohne Gewähr!
Über Rückmeldungen würde ich mich freuen.
Registriert seit: 16.08.2017
Version(en): 2007 / 2010 / Web
28.08.2017, 19:03
(Dieser Beitrag wurde zuletzt bearbeitet: 28.08.2017, 19:04 von 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
Registriert seit: 16.08.2017
Version(en): 2007 / 2010 / Web
28.08.2017, 20:24
(Dieser Beitrag wurde zuletzt bearbeitet: 28.08.2017, 20:29 von 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.
Registriert seit: 15.08.2017
Version(en): 2010
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
Registriert seit: 16.08.2017
Version(en): 2007 / 2010 / Web
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!
Registriert seit: 16.08.2017
Version(en): 2007 / 2010 / Web
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.
|