Übertrag in Zeile statt Spalte + Runden ...

Sub Uebertrag() Dim Liste_Quelle As Range, Liste_Ziel As Range Set Liste_Quelle = Range("B3,C3,D3,E3,F3,G3,H3") Set Liste_Ziel = Range("B4,C4,D4,E4,F4,G4,H4") For Each cell In Liste_Quelle If cell.Offset(0, 1).Value > 0 Then Liste_Ziel.Cells(1, 1).Value = cell.Value '** Set Liste_Ziel = Liste_Ziel.Offset(1) End If Next End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Guten Morgen Hans,
danke zunächst, aber die Sache ich nicht ganz so einfach, wie man erst denkt :o)
Oder sollte ich immer noch auf dem Holzweg sein?
a) Mein Übertragungskriterium ist ja, dass die Zahl nicht negativ ist. Wenn sie es ist, dann soll eine Null überragen werden.
b) Zudem kommt noch, dass in die jeweilige Zielzelle nur ein abgerundeter Wert geschrieben werden soll, so dass in der jeweiligen Ursprungszelle noch ein Wert erhalten bleibt. Der Sachverhalt im Excelblatt ist so, dass der Wert, der in die Zielzelle geschrieben wird vom Wert in der Ursprungszelle abgezogen wird.
c) Zudem soll nur ein so hoher Wert in die jeweilige Zielzelle geschrieben werden, dass in der Ursprungszelle ein Mindestbetrag erhalten bleibt.
Mein jetziger Stand ist:


Sub Uebertrag()
Dim Liste_Quelle As Range, Liste_Ziel As Range
Set Liste_Quelle = Range("B3,C3,D3,E3,F3,G3,H3")
Set Liste_Ziel = Range("B7,C7,D7,E7,F7,G7,H7")
Set Mindestbetrag = Range("A1")
For Each cell In Liste_Quelle
If cell.Offset(0).Value <= Mindestbetrag.Value Then
Liste_Ziel.Cells(0).Value = 0
Else
Liste_Ziel.Cells(0).Value = _
Application.WorksheetFunction.Round(cell.Value - Mindestbetrag.Value - 5, -1)
End If
Set Liste_Ziel = Liste_Ziel.Offset(1)
Next
End Sub

Guten Gruß,
Andreas

Sub Uebertragen() Dim rng As Range For Each rng In Range("B3:H3") If rng.Value > 0 Then rng.Offset(1, 0).Value = _ WorksheetFunction.Round( _ rng.Value - Range("A1").Value - 5, -1) Else rng.Offset(1, 0).Value = 0 End If Next rng End Sub

Sub Uebertragen() Dim rngSource As Range, rngTarget As Range, rngAct As Range Dim iCell As Integer Set rngSource = Range("B3:H3") Set rngTarget = Range("B4:H4") For iCell = 1 To rngSource.Cells.Count If rngSource(iCell).Value > 0 Then rngTarget(iCell).Value = _ WorksheetFunction.Round( _ rngSource(iCell).Value - Range("A1").Value - 5, -1) Else rngTarget(iCell).Value = 0 End If Next iCell End Sub

Beliebteste Forumthreads (12 Monate)

Übertrag in Zeile statt Spalte + Runden ...

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Übertrag in Zeile statt Spalte + Runden ...

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread