Optimal Pitstops (VBA)

Sun, 31 May 2026 01:57:00 +0100

Abstract

You manage a car racing team and you like to plan for optimal pitstops during a race?

Example:

Appendix – Optimal_Pitstops Code

Please read my Disclaimer.

Option Explicit

Sub optimale_boxenstopps()
'Calculates optimal pit stops for a car race.
'Source (EN): https://www.sulprobil.de/optimal_pitstops_en/
'Source (DE): https://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 lRounds                    As Long

Dim dRound_1                   As Double
Dim dRound_Time                As Double
Dim dReset_Time                As Double
Dim dTime_Total                As Double
Dim dTime_Best                 As Double
Dim dInrcement                 As Double
Dim dPit_Stop                  As Double

Dim sPit_Stops                 As String
Dim sComma                     As String
Dim sSemiColon                 As String

Dim state                      As SystemState 'See https://www.sulprobil.de/systemstate_en/

Set state = New SystemState

lRounds = Range("Number_of_Rounds")
ReDim lIdx(1 To lRounds) As Long
dRound_1 = Range("Time_Round_1")
dReset_Time = Range("Reset_Time")
dInrcement = Range("Increment")
dPit_Stop = Range("Pit_Stop")
Columns("E:G").ClearContents
Range("E4:G4").FormulaArray = Array("Anzahl Stopps", "Gesamtzeit [s]", "Stopps in Runde(n)")

For t = 0 To lRounds 'Anzahl der Boxenstopps
    dTime_Best = 1E+300
    ReDim c(1 To t + 2) As Long
    For j = 1 To t
        c(j) = j - 1
    Next j
    c(t + 1) = lRounds
    c(t + 2) = 0
    Do
        dTime_Total = 0#
        dRound_Time = dRound_1
        For i = 1 To lRounds
            dTime_Total = dTime_Total + dRound_Time
            For m = 1 To t
                If i = c(m) + 1 Then
                    dTime_Total = dTime_Total + dPit_Stop
                    dRound_Time = dReset_Time
                    Exit For
                End If
            Next m
            If m > t Then dRound_Time = dRound_Time + dInrcement
        Next i
        If (dTime_Best > dTime_Total) Or (Abs(dTime_Best - dTime_Total) < 0.000000001) Then
            If dTime_Best > dTime_Total Then
                dTime_Best = dTime_Total
                sPit_Stops = ""
                sSemiColon = ""
            End If
            sComma = ""
            sPit_Stops = sPit_Stops & sSemiColon
            For m = 1 To t
                sPit_Stops = sPit_Stops & 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) = dTime_Best
    Cells(t + 5, 7) = sPit_Stops
Next t

Columns("E:G").EntireColumn.AutoFit
If Columns("G:G").ColumnWidth > 70 Then Columns("G:G").ColumnWidth = 70

End Sub

Download

Please read my Disclaimer.

Car Race on Sulprobil

Optimal Pitstops (VBA)

Abstract

Appendix – Optimal_Pitstops Code

Download