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