Abstract
Sie managen ein Autorennteam und wollen die optimalen Boxenstopps für ein Rennen planen?
Beispiel:
Appendix – Programmcode Optimale_Boxenstopps
Bitte den Haftungsausschluss im Impressum beachten.
Option Explicit
Sub optimale_boxenstopps()
'Berechnet optimale Boxenstopps für ein Autorennteam.
'Source (EN): http://www.sulprobil.de/optimal_pitstops_en/
'Source (DE): http://www.berndplumhoff.de/optimale_boxenstopps_de/
'(C) (P) by Bernd Plumhoff 01-Jan-2023 PB V0.2
Dim i As Long
Dim j As Long
Dim k As Long
Dim m As Long
Dim t As Long
Dim lRunden As Long
Dim dStartzeit As Double
Dim dRundenZeit As Double
Dim dResetZeit As Double
Dim dZeitTotal As Double
Dim dZeitBest As Double
Dim dInkrement As Double
Dim dBoxenstopp As Double
Dim sBoxenstopps As String
Dim sComma As String
Dim sSemiColon As String
Dim state As SystemState 'Siehe https://www.berndplumhoff.de/systemstate_de/
Set state = New SystemState
lRunden = Range("Anzahl_Runden")
ReDim lIdx(1 To lRunden) As Long
dStartzeit = Range("Startzeit")
dResetZeit = Range("Resetzeit")
dInkrement = Range("Inkrement")
dBoxenstopp = Range("Boxenstopp")
Columns("E:G").ClearContents
Range("E4:G4").FormulaArray = Array("Anzahl Stopps", "Gesamtzeit [s]", "Stopps in Runde(n)")
For t = 0 To lRunden 'Anzahl der Boxenstopps
dZeitBest = 1E+300
ReDim c(1 To t + 2) As Long
For j = 1 To t
c(j) = j - 1
Next j
c(t + 1) = lRunden
c(t + 2) = 0
Do
dZeitTotal = 0#
dRundenZeit = dStartzeit
For i = 1 To lRunden
dZeitTotal = dZeitTotal + dRundenZeit
For m = 1 To t
If i = c(m) + 1 Then
dZeitTotal = dZeitTotal + dBoxenstopp
dRundenZeit = dResetZeit
Exit For
End If
Next m
If m > t Then dRundenZeit = dRundenZeit + dInkrement
Next i
If (dZeitBest > dZeitTotal) Or (Abs(dZeitBest - dZeitTotal) < 0.000000001) Then
If dZeitBest > dZeitTotal Then
dZeitBest = dZeitTotal
sBoxenstopps = ""
sSemiColon = ""
End If
sComma = ""
sBoxenstopps = sBoxenstopps & sSemiColon
For m = 1 To t
sBoxenstopps = sBoxenstopps & sComma & c(m) + 1
sComma = ", "
Next m
sSemiColon = "; "
End If
j = 1
Do While c(j) + 1 = c(j + 1)
c(j) = j - 1
j = j + 1
Loop
c(j) = c(j) + 1
Loop Until j > t
Cells(t + 5, 5) = t
Cells(t + 5, 6) = dZeitBest
Cells(t + 5, 7) = sBoxenstopps
Next t
Columns("E:G").EntireColumn.AutoFit
If Columns("G:G").ColumnWidth > 70 Then Columns("G:G").ColumnWidth = 70
End Sub
Download
Bitte den Haftungsausschluss im Impressum beachten.
optimale_boxenstopps.xlsm [45 KB Excel Datei, Download und Nutzung auf eigene Gefahr]