Optimale Boxenstopps (VBA)

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

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): 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 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.

Boxenstopps on Bernd Plumhoff

Optimale Boxenstopps (VBA)

Abstract

Appendix – Programmcode Optimale_Boxenstopps

Download