PDA

Vollständige Version anzeigen : Abzug Werte in verschiedenen zellen


Ben4711
25.08.2017, 10:37
Hallo zusammen,

ich komme mit meinem Problem nicht weiter.
Vielleicht kann mir jemand helfen?

Ich habe 9 Tabellen mit Zahlen.
Ich möchte nun in Spalte "D4" einen Wert eintragen,
dieser Wert soll anschließend von Werten in E4-R4 wie folgt abgezogen werden:
Zu Beginn:
Wert E4 = 30 Wert F4= 20
Eingabe Wert D4= 40
Darausfolgt: E4 = 0 und F4=10 und am Ende D4=leer
usw.
Das ganze gilt für jede Zeile bis 245, sobald in der Spalte "D" ein Wert eingetragen wird (jeweils für die entsprechende Zeile).
Code läuft ohne Fehler durch das Debuggen, aber das gewünschte Ergebnis wird nicht erzielt.
Wo liegt mein Fehler?


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) ' reduced 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

feliweb
25.08.2017, 12:02
Hi,

kurze Frage zu deinem Beispiel, hast du dich da verrechnet?

E4=30
F4=20

D4=40

E4-D4=-10
F4-D4=-20

So wäre mein Verständnis von deinem Problem.
Soll die Berechnung für das komplette Blatt (also für alle D aufeinmal) erfolgen oder in dem Moment, wenn du eine Zahl D einträgst?


Wenn meine Berechnung richtig ist und das erstmal alle D ausgefüllt werden und dann das Makro startet, wäre hier mein Vorschlag:



Sub rechnen()

'i Spalten
'j Zeilen

For j = 4 To 245

For i = 5 To 18

Cells(j, i) = Cells(j, i) - Cells(j, 4)


Next i
Cells(j, 4) = ""
Next j

End Sub





Hier eine Version, die auf Eingaben in Spalte D "hört"



Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Target, Range("D:D")) Is Nothing Then
For i = 5 To 18


If Cells(Target.Row, 4) <> "" Then
r = Cells(Target.Row, 4)
Cells(Target.Row, 4) = ""
End If

Cells(Target.Row, i) = Cells(Target.Row, i) - r


Next i


End If
End Sub