Simulation Kreuzung-Autos bewegen sich unregelmäss

Hallo alle zusammen
Ich habe in Excel eine Simulation einer Kreuzung gemacht. Diese funktioniert nun fast perfekt. Die Autos bewegen sich leider nur unregelmässig. Manchmal eine Sekunde manchmal eine halbe und manchmal 2 sekunden.
Wie könnte ich nun das Problem lösen?
Arbeitsmappe:
http://www.fast-load.net/index.php?pid=89dbe1cbb29936574dd6a553d6de1d06
Oder Code:
Modul 1:
Public Auto1
Public Auto2
Public Auto3
Public Auto4
Public Auto11
Public Auto22
Public Auto33
Public Auto44
Public Zeit3
Public Oben
Public Links
Public Rechts
Public Unten


Sub AutoOben()
Randomize
On Error GoTo Fehler
For eZ = 1 To 14
iZ = 15 - eZ
If iZ = 1 Then
If Auto11 > 0 Then
If Range("Oben" & iZ) = "" Then
Range("Oben" & iZ) = Round(Rnd() * 2) + 1
Auto11 = Auto11 - 1
GoTo Weiter
End If
Else
If Range("Rechts" & iZ) > 0 Then
If Range("Rechts" & iZ + 1) = "" Then
Range("Rechts" & iZ + 1) = Range("Rechts" & iZ)
Range("Rechts" & iZ) = ""
End If
End If
End If
End If
If iZ = 6 Then
If Range("AmpelOben") = 2 Then
If Range("Oben" & iZ) > 0 Then
If Range("Oben" & iZ + 1) = "" Then
Range("Oben" & iZ + 1) = Range("Oben" & iZ)
Range("Oben" & iZ) = ""
End If
End If
End If
Else
If Range("Oben" & iZ) > 0 Then
If Range("Oben" & iZ + 1) = "" Then
Range("Oben" & iZ + 1) = Range("Oben" & iZ)
Range("Oben" & iZ) = ""
End If
End If
End If
GoTo Weiter
Fehler:
Range("Oben" & iZ) = ""
Auto1 = 1
Weiter:
Next eZ
End Sub


Sub AutoLinks()
Randomize
On Error GoTo Fehler
For eZ = 1 To 14
iZ = 15 - eZ
If iZ = 1 Then
If Auto22 > 0 Then
If Range("Links" & iZ) = "" Then
Range("Links" & iZ) = Round(Rnd() * 2) + 1
Auto22 = Auto22 - 1
GoTo Weiter
End If
Else
If Range("Rechts" & iZ) > 0 Then
If Range("Rechts" & iZ + 1) = "" Then
Range("Rechts" & iZ + 1) = Range("Rechts" & iZ)
Range("Rechts" & iZ) = ""
End If
End If
End If
End If
If iZ = 6 Then
If Range("AmpelLinks") = 2 Then
If Range("Links" & iZ) > 0 Then
If Range("Links" & iZ + 1) = "" Then
Range("Links" & iZ + 1) = Range("Links" & iZ)
Range("Links" & iZ) = ""
End If
End If
End If
Else
If Range("Links" & iZ) > 0 Then
If Range("Links" & iZ + 1) = "" Then
Range("Links" & iZ + 1) = Range("Links" & iZ)
Range("Links" & iZ) = ""
End If
End If
End If
GoTo Weiter
Fehler:
Range("Links" & iZ) = ""
Auto2 = 1
Weiter:
Next eZ
End Sub


Sub AutoUnten()
Randomize
On Error GoTo Fehler
For eZ = 1 To 14
iZ = 15 - eZ
If iZ = 1 Then
If Auto33 > 0 Then
If Range("Unten" & iZ) = "" Then
Range("Unten" & iZ) = Round(Rnd() * 2) + 1
Auto33 = Auto33 - 1
GoTo Weiter
End If
Else
If Range("Rechts" & iZ) > 0 Then
If Range("Rechts" & iZ + 1) = "" Then
Range("Rechts" & iZ + 1) = Range("Rechts" & iZ)
Range("Rechts" & iZ) = ""
End If
End If
End If
End If
If iZ = 6 Then
If Range("AmpelUnten") = 2 Then
If Range("Unten" & iZ) > 0 Then
If Range("Unten" & iZ + 1) = "" Then
Range("Unten" & iZ + 1) = Range("Unten" & iZ)
Range("Unten" & iZ) = ""
End If
End If
End If
Else
If Range("Unten" & iZ) > 0 Then
If Range("Unten" & iZ + 1) = "" Then
Range("Unten" & iZ + 1) = Range("Unten" & iZ)
Range("Unten" & iZ) = ""
End If
End If
End If
GoTo Weiter
Fehler:
Range("Unten" & iZ) = ""
Auto3 = 1
Weiter:
Next eZ
End Sub


Sub AutoRechts()
Randomize
On Error GoTo Fehler
For eZ = 1 To 14
iZ = 15 - eZ
If iZ = 1 Then
If Auto44 > 0 Then
If Range("Rechts" & iZ) = "" Then
Range("Rechts" & iZ) = Round(Rnd() * 2) + 1
Auto44 = Auto44 - 1
GoTo Weiter
End If
Else
If Range("Rechts" & iZ) > 0 Then
If Range("Rechts" & iZ + 1) = "" Then
Range("Rechts" & iZ + 1) = Range("Rechts" & iZ)
Range("Rechts" & iZ) = ""
End If
End If
End If
End If
If iZ = 6 Then
If Range("AmpelRechts") = 2 Then
If Range("Rechts" & iZ) > 0 Then
If Range("Rechts" & iZ + 1) = "" Then
Range("Rechts" & iZ + 1) = Range("Rechts" & iZ)
Range("Rechts" & iZ) = ""
End If
End If
End If
Else
If Range("Rechts" & iZ) > 0 Then
If Range("Rechts" & iZ + 1) = "" Then
Range("Rechts" & iZ + 1) = Range("Rechts" & iZ)
Range("Rechts" & iZ) = ""
End If
End If
End If
GoTo Weiter
Fehler:
Range("Rechts" & iZ) = ""
Auto4 = 1
Weiter:
Next eZ
End Sub


Sub AutosFahren()
If Oben > Links And Oben > Unten And Oben > Rechts Then
AutoOben
Oben = ""
Else
If Links > Oben And Links > Unten And Links > Rechts Then
AutoLinks
Links = ""
Else
If Unten > Oben And Unten > Links And Unten > Rechts Then
AutoUnten
Unten = ""
Else
AutoRechts
Rechts = ""
End If
End If
End If
If Oben = "" Then
If Links


Sub Autos()
Randomize
Rechts = Rnd()
Links = Rnd()
Oben = Rnd()
Unten = Rnd()
If Range("T1") > Range("AnzahlAutos") Then GoTo Weiter4
Randomize
Auto1 = 0
If Rnd()


Sub Start()
Set Zeit3 = Range("Geschwindigkeit3")
Auto1 = 1
Auto2 = 1
Auto3 = 1
Auto4 = 1
Autos
initialisierung
End Sub

Modul 2:
Public Ampel1
Public Ampel2
Public Ampel3
Public Ampel4
Public Ampel
Public Zeit1
Public Zeit2


Sub initialisierung()
Set Ampel1 = Range("A1")
Set Ampel2 = Range("A2")
Set Ampel3 = Range("A3")
Set Ampel4 = Range("A4")
Set Zeit1 = Range("Geschwindigkeit1")
Set Zeit2 = Range("Geschwindigkeit2")
Ampel = 1
AmpelsteuerungAmpel1Rot
End Sub


Sub AmpelsteuerungAmpel1Rot()
If Ampel = 1 Then
If Ampel1 = 1 Then
Range("AmpelOben") = 1
Application.OnTime Time + TimeValue("00:00:0" & Zeit1), "AmpelsteuerungAmpel1Grün"
Else
Ampel = 2
AmpelsteuerungAmpel2Rot
End If
Else
AmpelsteuerungAmpel2Rot
End If
End Sub


Sub AmpelsteuerungAmpel1Grün()
Range("AmpelOben") = 2
Application.OnTime Time + TimeValue("00:00:" & Zeit2), "AmpelsteuerungAmpel1Orange"
End Sub


Sub AmpelsteuerungAmpel1Orange()
If Ampel1 = 1 Then
If Ampel2 = 0 Then
If Ampel3 = 0 Then
If Ampel4 = 0 Then
AmpelsteuerungAmpel1Grün
Else
Range("AmpelOben") = 1
Application.OnTime Time + TimeValue("00:00:0" & Zeit1), " _
AmpelsteuerungAmpel1Ende"
End If
Else
Range("AmpelOben") = 1
Application.OnTime Time + TimeValue("00:00:0" & Zeit1), "AmpelsteuerungAmpel1Ende"
End If
Else
Range("AmpelOben") = 1
Application.OnTime Time + TimeValue("00:00:0" & Zeit1), "AmpelsteuerungAmpel1Ende"
End If
Else
Range("AmpelOben") = 1
Application.OnTime Time + TimeValue("00:00:0" & Zeit1), "AmpelsteuerungAmpel1Ende"
End If
End Sub


Sub AmpelsteuerungAmpel1Ende()
Range("AmpelOben") = 0
Ampel = 2
AmpelsteuerungAmpel2Rot
End Sub


Sub AmpelsteuerungAmpel2Rot()
If Ampel = 2 Then
If Ampel2 = 1 Then
Range("AmpelLinks") = 1
Application.OnTime Time + TimeValue("00:00:0" & Zeit1), "AmpelsteuerungAmpel2Grün"
Else
Ampel = 3
AmpelsteuerungAmpel3Rot
End If
Else
AmpelsteuerungAmpel3Rot
End If
End Sub


Sub AmpelsteuerungAmpel2Grün()
Range("AmpelLinks") = 2
Application.OnTime Time + TimeValue("00:00:" & Zeit2), "AmpelsteuerungAmpel2Orange"
End Sub


Sub AmpelsteuerungAmpel2Orange()
If Ampel1 = 0 Then
If Ampel2 = 1 Then
If Ampel3 = 0 Then
If Ampel4 = 0 Then
AmpelsteuerungAmpel2Grün
Else
Range("AmpelLinks") = 1
Application.OnTime Time + TimeValue("00:00:0" & Zeit1), " _
AmpelsteuerungAmpel2Ende"
End If
Else
Range("AmpelLinks") = 1
Application.OnTime Time + TimeValue("00:00:0" & Zeit1), "AmpelsteuerungAmpel2Ende"
End If
Else
Range("AmpelLinks") = 1
Application.OnTime Time + TimeValue("00:00:0" & Zeit1), "AmpelsteuerungAmpel2Ende"
End If
Else
Range("AmpelLinks") = 1
Application.OnTime Time + TimeValue("00:00:0" & Zeit1), "AmpelsteuerungAmpel2Ende"
End If
End Sub


Sub AmpelsteuerungAmpel2Ende()
Range("AmpelLinks") = 0
Ampel = 3
AmpelsteuerungAmpel3Rot
End Sub


Sub AmpelsteuerungAmpel3Rot()
If Ampel = 3 Then
If Ampel3 = 1 Then
Range("AmpelUnten") = 1
Application.OnTime Time + TimeValue("00:00:0" & Zeit1), "AmpelsteuerungAmpel3Grün"
Else
Ampel = 4
AmpelsteuerungAmpel4Rot
End If
Else
AmpelsteuerungAmpel4Rot
End If
End Sub


Sub AmpelsteuerungAmpel3Grün()
Range("AmpelUnten") = 2
Application.OnTime Time + TimeValue("00:00:" & Zeit2), "AmpelsteuerungAmpel3Orange"
End Sub


Sub AmpelsteuerungAmpel3Orange()
If Ampel1 = 0 Then
If Ampel2 = 0 Then
If Ampel3 = 1 Then
If Ampel4 = 0 Then
AmpelsteuerungAmpel3Grün
Else
Range("AmpelUnten") = 1
Application.OnTime Time + TimeValue("00:00:0" & Zeit1), " _
AmpelsteuerungAmpel3Ende"
End If
Else
Range("AmpelUnten") = 1
Application.OnTime Time + TimeValue("00:00:0" & Zeit1), "AmpelsteuerungAmpel3Ende"
End If
Else
Range("AmpelUnten") = 1
Application.OnTime Time + TimeValue("00:00:0" & Zeit1), "AmpelsteuerungAmpel3Ende"
End If
Else
Range("AmpelUnten") = 1
Application.OnTime Time + TimeValue("00:00:0" & Zeit1), "AmpelsteuerungAmpel3Ende"
End If
End Sub


Sub AmpelsteuerungAmpel3Ende()
Range("AmpelUnten") = 0
Ampel = 4
AmpelsteuerungAmpel4Rot
End Sub


Sub AmpelsteuerungAmpel4Rot()
If Ampel = 4 Then
If Ampel4 = 1 Then
Range("AmpelRechts") = 1
Application.OnTime Time + TimeValue("00:00:0" & Zeit1), "AmpelsteuerungAmpel4Grün"
Else
Ampel = 1
Application.OnTime Time + TimeValue("00:00:0" & Zeit1), "AmpelsteuerungAmpel4Ende"
End If
Else
Application.OnTime Time + TimeValue("00:00:0" & Zeit1), "AmpelsteuerungAmpel4Ende"
End If
End Sub


Sub AmpelsteuerungAmpel4Grün()
Range("AmpelRechts") = 2
Application.OnTime Time + TimeValue("00:00:" & Zeit2), "AmpelsteuerungAmpel4Orange"
End Sub


Sub AmpelsteuerungAmpel4Orange()
If Ampel1 = 0 Then
If Ampel2 = 0 Then
If Ampel3 = 0 Then
If Ampel4 = 1 Then
AmpelsteuerungAmpel4Grün
Else
Range("AmpelRechts") = 1
Application.OnTime Time + TimeValue("00:00:0" & Zeit1), " _
AmpelsteuerungAmpel4Ende"
End If
Else
Range("AmpelRechts") = 1
Application.OnTime Time + TimeValue("00:00:0" & Zeit1), "AmpelsteuerungAmpel4Ende"
End If
Else
Range("AmpelRechts") = 1
Application.OnTime Time + TimeValue("00:00:0" & Zeit1), "AmpelsteuerungAmpel4Ende"
End If
Else
Range("AmpelRechts") = 1
Application.OnTime Time + TimeValue("00:00:0" & Zeit1), "AmpelsteuerungAmpel4Ende"
End If
End Sub


Sub AmpelsteuerungAmpel4Ende()
Range("AmpelRechts") = 0
Ampel = 1
Application.OnTime Time + TimeValue("00:00:01"), "AmpelsteuerungAmpel1Rot"
End Sub

Vielen Dank schon im Vorraus
Stifi

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo, @Stifi,
da ich excel2003 einsetze und Du in Deiner Anwendung überlappende Bereich und bedingte Formatierungen benutzt, die wohl erst mit EXCEL2007 wirklich funktioneren, kann ich nicht sagen, ob ich richtig Dein Programm nach EXCEL20003 transformiert habe , denn die Anpelschaltungen und auch einige Fahrzeugbewegungen laufen am realen Leben betrachtet "ungewohnt".
Jedoch meine ich, Deinen Wunsch nachvollziehen zu können, die Fahrzeugflüsse mit gleichmäßiger Gewschwindigkeit darzustellen. Jedoch meine ich dann auch, dass Du vermutlich eine andere interne Taktsteuerung vorsehen solltest, nämlich einen Grundtakt, der dann zu bestimmten Vielfachen von Grundeinheiten die Ereignisse auslöst.
Am Beispiel: Die Grundeinheit, der Takt, betraägt 1 sec (ggf. kann auch die Funktion TimeValue als Parameter auch CDate(Zeit3/24/60/60) enthalten, so dass auch Teile von Sekunden übergeben werden können).
In diesem Zeitintervall wird das OnTime-Ereignis ausgeführt. In diesem wird die Dauer für die einzelnen Teilereignisse verwaltet und die entsprechenden Aktionen bei erreichen der Grenzwerte ausgelöst. Der Zeitzähler (ggf. als Static deklariert) des Ereignisses wird auf Null gesetzt, wenn das Ereignis ausgeführt wurde. Ob ich damit richtig liege und zur Lösung des Problems beitrage, habe ich nicht getestet und da ich auch nicht weiß, wie eine Schlange von OnTimer-Ereignisse abgearbeitet werden, die auf gleicher Zeit liegen.
Gruß,
Uwe

Beliebteste Forumthreads (12 Monate)

Simulation Kreuzung-Autos bewegen sich unregelmäss

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread