Excel Zielwertsuche

[duckdonald]

Aber auch unter Office07 gibt es die Makroeinstellungen (Entwicklertools->Makrosicherheit)

Weiterhin funktioniert das einfügen des Codes genauso, allerdings muss nach dem ändern der Makrosicherheit die Arbeitsmappe neu geöffnet werden.

Und die automatische Anpassung der 2. Zelle schließt sich ja schon aus, da die erste Zahl ermittelt wird und somit schon H45=B36 ist, also eine darauffolgende Zielwertermittlung einfach übersprungen werden würde.

DD

 

[BlockeR]

Habe die Datei mal mit Skizzen eingefügt, um das Problem besser sichtbar zu machen. Eine kleine Problemstellung bzw. Randbedingung steht mit rotem Text in der Datei.

 

[BlockeR]

So, habe noch einmal etwas geändert und das Problem wieder mit in die Datei geschrieben. Die zwei Skizzen sollten etwas mehr Klarheit in mein Thema bringen.

Trotzdem schon einmal ein Danke an euch!

 

[duckdonald]

Auf Basis des Scriptes der automatischen Zielwertsuche nun noch eine manuelle drumrum gestrickt.

Soll heißen beide Zellen auf 0 setzen, dann Zielwertsuche für D19 (Bedingung C26=0)
und nun
solange B36 > H45 addiere zu C19 +0,001 und automatische Zielwertsuche für D19 (Bedingung C26=0)

Achtung das Script ist nur so dahingeworfen und braucht (bei mir) ca 65sek zur Lösungsfindung!
Mit ein paar Anpassungen lässt sich das noch senken (aber nicht um diese Uhrzeit :suspekt.

DD

 

[BlockeR]

Oh Top...das funktioniert. Wenn ich das richtig mitbekomme habe, dann braucht meiner 170sek dafür. So ein bisschen seh ich sogar durch(bei der Erklärung zumindest). Mein letzter Wunsch: kreigst du das auch noch für 3Rollen hin? Habe mal wieder die Werte per manueller Itteration herausbekommen. Die 2. Rolle würde demnach mit einer Kraft von 0,5N andrücken (siehe Anhang). Das wäre der letzte Fall für meine Betrachtung übrigens

Danke für die bisherigen Bemühungen!

 

[duckdonald]

Zuersteinmal Codeoptimierung - tausche den vorhandenen durch diesen aus:

Sub losung()
'  zeit = Timer
  Range("C19:D19").Value = 0
  Range("C26").GoalSeek Goal:=0, ChangingCell:=Range("D19")
  Do
    If (Cells(36, 2).Value - Cells(45, 8).Value) * -1 > 0.5 Then
      Cells(19, 3) = Cells(19, 3) + 0.01
    Else
      Cells(19, 3) = Cells(19, 3) + 0.001
    End If
    If Cells(26, 3) <> 0 Then
      i = 0
      Range("C26").GoalSeek Goal:=0, ChangingCell:=Range("D19")
    End If
  
  Loop Until Cells(36, 2).Value > Cells(45, 8).Value
  
'  zeit = Timer - zeit
'  Cells(2, 1).Value = "Aktualisierungszeit: " & zeit & "sek"

End Sub

Solange die Differenz H45 und B36 groß ist, mache große Schritte, ansonsten kleinere. Bei mir braucht das Script nun nur noch 11 sekunden zur Lösungsfindung.

Und zu den Problem mit 3 Rollen . . . . . . . egal welche der 3 Zellen ich verändere (und in welchen ausmaße) die Zelle H45 bleibt gleich, Ursache wird wohl die veränderte Zelle C26 sein. Aber so, lässt dich das Script nicht anwenden.

DD