Simulation Kreuzung-Autos bewegen sich unregelmäss
25.05.2008 15:15:00
Stifi
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