Hallo,

bei mir kommt immer der Laufzeitfehler 5 bei folgender Programmierung. Wie kann ich dies beheben?

Option Explicit

Public Function Günstigste() As String

Dim Haefen As Collection

Rem min-Kosten pro hafen (wert 0 = noch nicht gefunden)
Dim kostenBahn As Collection
Dim kostenUmschlag As Collection
Dim kostenSchiff As Collection
Dim guenstigsteNameBahn As Collection
Dim guenstigsteNameUmschlag As Collection
Dim guenstigsteNameSchiff As Collection

Set Haefen = New Collection
Set kostenBahn = New Collection
Set kostenUmschlag = New Collection
Set kostenSchiff = New Collection
Set guenstigsteNameBahn = New Collection
Set guenstigsteNameUmschlag = New Collection
Set guenstigsteNameSchiff = New Collection

Call HaefenErmitteln(Haefen)
Call KostenErmitteln(Haefen, kostenSchiff, guenstigsteNameSchiff, kostenBahn, guenstigsteNameBahn, kostenUmschlag, guenstigsteNameUmschlag)

Günstigste = GuenstigsteErmitteln(Haefen, kostenSchiff, guenstigsteNameSchiff, kostenBahn, guenstigsteNameBahn, kostenUmschlag, guenstigsteNameUmschlag)
MsgBox Günstigste

End Function

Private Function HaefenErmitteln(Haefen As Collection)

    Dim hafenIdx As Integer
    Dim hafen As String
    Dim c As Object
    
    Dim firstAddress As Variant

    Rem Ermitteln, von welchen Hafen Schiff zu Zielort möglich ist
    With Tabelle1.Range("C2:C65535")
        Rem Zielort finden
        Set c = .Find(Tabelle2.Range("B2").Value)
        If Not c Is Nothing Then
            firstAddress = c.Address
            Do
                Rem Zeitraum vergleichen
                If c.Offset(0, 1).Value = Tabelle2.Range("B3").Value Then
                    Rem Hafennamen auslesen
                    hafen = c.Offset(0, -2).Value
                    
                    Rem Prüfen, ob Hafenname schon mal verarbeitet
                    For hafenIdx = 0 To Haefen.Count - 1
                        If Haefen.Item(hafenIdx + 1) = hafen Then
                            Exit For
                        End If
                    Next hafenIdx
                    
                    If hafenIdx = Haefen.Count Then
                        If Haefen.Count = 0 Then
                            Rem Hafen vorher noch nicht gefunden
                            Haefen.Add (CStr(hafen))
                        Else
                            If Not Haefen.Item(Haefen.Count) = hafen Then
                                Rem Hafen vorher noch nicht gefunden
                                Haefen.Add (CStr(hafen))
                            End If
                        End If
                    End If
                End If
                Set c = .FindNext(c)
            Loop While Not c Is Nothing And c.Address <> firstAddress
        End If
    End With
End Function

Private Function KostenErmitteln(Haefen As Collection, kostenSchiff As Collection, guenstigsteNameSchiff As Collection, kostenBahn As Collection, guenstigsteNameBahn As Collection, kostenUmschlag As Collection, guenstigsteNameUmschlag As Collection)

    Dim hafenIdx As Integer
    Dim hafen As String
    
    Dim guenstigsteKosten As Integer
    Dim guenstigsteName As String

    Dim kosten As Integer
    Dim name As String
    
    Dim kostenZiel As Collection
    Dim guenstigsteNameZiel As Collection

    Dim logistikInZeile As String
    
    Dim c As Object
    Dim i As Integer
    
    Dim firstAddress As Variant

    With Tabelle1.Range("A2:A65535")
        hafenIdx = 0
        For hafenIdx = 0 To Haefen.Count - 1
            hafen = Haefen(hafenIdx + 1)
        
            Set c = .Find(hafen)
            firstAddress = c.Address
            Do
                logistikInZeile = c.Offset(0, 4).Value
                
                Rem Sicherstellen, dass bei "Schiff" nur richtiger Zielort und Zeitraum bewertet wird
                If logistikInZeile <> "Schiff" Or (logistikInZeile = "Schiff" And c.Offset(0, 2).Value = Tabelle2.Range("B2").Value And c.Offset(0, 3).Value = Tabelle2.Range("B3").Value) Then
                    Select Case logistikInZeile
                        Case "Schiff"
                            Set kostenZiel = kostenSchiff
                            Set guenstigsteNameZiel = guenstigsteNameSchiff
                        Case "Bahn"
                            Set kostenZiel = kostenBahn
                            Set guenstigsteNameZiel = guenstigsteNameBahn
                        Case "Umschlag"
                            Set kostenZiel = kostenUmschlag
                            Set guenstigsteNameZiel = guenstigsteNameUmschlag
                    End Select
                    
                    i = 0
                    guenstigsteKosten = -1
                    guenstigsteName = ""
                    Do While Tabelle1.Range("F1").Offset(0, i).Value <> "" And Tabelle1.Range("F1").Offset(0, i).Value <> ""
                        name = Tabelle1.Range("F1").Offset(0, i).Value
                        kosten = c.Offset(0, 5 + i).Value
                        
                        If kosten <> 0 And (guenstigsteKosten = -1 Or kosten < guenstigsteKosten) Then
                            guenstigsteName = name
                            guenstigsteKosten = CInt(kosten)
                        End If
                        i = i + 1
                    Loop
                    
                    If hafenIdx = kostenZiel.Count Then
                        kostenZiel.Add (guenstigsteKosten)
                        guenstigsteNameZiel.Add (guenstigsteName)
                    Else
                        Rem Überschreibe Wert an Stelle (nur möglich, wenn zwei gleiche Zeilen pro Hafen + Logistik)
                        kostenZiel(hafenIdx + 1) = guenstigsteKosten
                        guenstigsteNameZiel(hafenIdx + 1) = guenstigsteName
                    End If
                End If
                Set c = .FindNext(c)
            Loop While Not c Is Nothing And c.Address <> firstAddress
            
            Rem auffüllen, wenn etwas nicht gefunden (Schiff wird immer gefunden wg. sub HaefenErmitteln
            If hafenIdx = kostenUmschlag.Count Then
                kostenSchiff.Add (-1)
            End If
            If hafenIdx = kostenBahn.Count Then
                kostenBahn.Add (-1)
            End If
        Next hafenIdx
    End With
End Function

Private Function GuenstigsteErmitteln(Haefen As Collection, kostenSchiff As Collection, guenstigsteNameSchiff As Collection, kostenBahn As Collection, guenstigsteNameBahn As Collection, kostenUmschlag As Collection, guenstigsteNameUmschlag As Collection) As String

    Dim hafenIdx As Integer
    Dim kosten As Integer
    
    Dim guenstigsteKosten As Integer
    Dim guenstigsteHafenIdx As Integer
    
    hafenIdx = 0
    guenstigsteKosten = -1
    For hafenIdx = 0 To Haefen.Count - 1
        
        Rem Ausschließen, wenn entweder keine Bahn oder kein Umschlag
        If kostenBahn(hafenIdx + 1) <> -1 And kostenUmschlag(hafenIdx + 1) <> -1 Then
            kosten = kostenSchiff(hafenIdx + 1) + kostenUmschlag(hafenIdx + 1) + kostenBahn(hafenIdx + 1)
            
            If guenstigsteKosten = -1 Or kosten < guenstigsteKosten Then
                guenstigsteKosten = kosten
                guenstigsteHafenIdx = hafenIdx
            End If
        End If
    Next hafenIdx
    
    GuenstigsteErmitteln = "Guenstigster Hafen: " + Haefen(guenstigsteHafenIdx + 1) + " - Kosten: " + CStr(guenstigsteKosten) + " - Schiff: " + guenstigsteNameSchiff(guenstigsteHafenIdx + 1) + " - Umschlag: " + guenstigsteNameUmschlag(guenstigsteHafenIdx + 1) + " - Bahn: " + guenstigsteNameBahn(guenstigsteHafenIdx + 1)
End Function