Makro Schleife

Hallo, ich habe mal ne Frage. Ich versuche ein Makro zu schreiben, daß einen Wert verändert, den Solver betätigt, und das Ergebnis an eine bestimmte Stelle im Sheet einträgt. Der Wert wird nun wieder geändert, der Solver ausgeführt, das Ergebnis soll aber nun nicht in d34 eingetragen werden sondern in d36, dann in d38 usw. Ich hoffe jemand von Euch hat dafür eine Lösung.
So schaut es bis jetzt aus, und es funktioniert auch soweit. Nur für die Sache mit dem Ergebnis eintragen habe ich keine Lösung.


Sub Makro6()
' Makro6 Makro
' Makro am 08.09.2004 von _ aufgezeichnet
Dim x As Single
x = -0.3
Do While x < 0.8
Range("B2").Select
ActiveCell.FormulaR1C1 = x
Range("B3").Select
SolverOk SetCell:="$B$29", MaxMinVal:=1, ValueOf:="0", ByChange:="$B$16:$B$25"
SolverSolve userfinish:=True
SolverOk SetCell:="$B$29", MaxMinVal:=1, ValueOf:="0", ByChange:="$B$16:$B$25"
SolverSolve userfinish:=True
SolverOk SetCell:="$B$29", MaxMinVal:=1, ValueOf:="0", ByChange:="$B$16:$B$25"
SolverSolve userfinish:=True
SolverOk SetCell:="$B$29", MaxMinVal:=1, ValueOf:="0", ByChange:="$B$16:$B$25"
SolverSolve userfinish:=True
ActiveWindow.SmallScroll Down:=12
Range("C29:C30").Select
Selection.Copy
Range("d34").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveWindow.SmallScroll Down:=-24
x = x + 0.02
Loop
End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Makro6() ' Makro6 Makro ' Makro am 08.09.2004 von _ aufgezeichnet Dim x As Single x = -0.3 Dim L As Integer L = 34 Do While x < 0.8 Range("B2").Select ActiveCell.FormulaR1C1 = x Range("B3").Select SolverOk SetCell:="$B$29", MaxMinVal:=1, ValueOf:="0", ByChange:="$B$16:$B$25" SolverSolve userfinish:=True SolverOk SetCell:="$B$29", MaxMinVal:=1, ValueOf:="0", ByChange:="$B$16:$B$25" SolverSolve userfinish:=True SolverOk SetCell:="$B$29", MaxMinVal:=1, ValueOf:="0", ByChange:="$B$16:$B$25" SolverSolve userfinish:=True SolverOk SetCell:="$B$29", MaxMinVal:=1, ValueOf:="0", ByChange:="$B$16:$B$25" SolverSolve userfinish:=True ActiveWindow.SmallScroll Down:=12 Range("C29:C30").Select Selection.Copy Destination:=ActiveSheet.Cells(L, 4) ==>Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False ActiveWindow.SmallScroll Down:=-24 L = L + 2 x = x + 0.02 Loop End Sub

Beliebteste Forumthreads (12 Monate)

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

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread