VisualBasic VBA Script wird nach jedem Durchlauf langsamer

[MickH74]

Hallo Forum,

ich habe ein komisches Problem um wollte mal fragen, ob vielleicht jemand helfen kann.

Hintergrundinfo: Ich programmiere eine Hilfe zu dem PC-Spiel Elite Dangerous, die bei der Suche nach einer guten Handelsroute helfen soll. Dabei gibt es Stationen, auf denen man verschiedene Waren kaufen und auch wieder verkaufen kann. Dieser Teil des Script, vergleicht die Ein- und Verkaufspreise jedes Rohstoffs für jede Start- und Zielstation und notiert die besten Profite.

Problem: Nach dem Öffnen der Datei läuft das Script in etwa 5 Sekunden durch. Starte ich es danach noch mal, so dauert der Durchlauf schon 45 Sekunden. Beim dritten Start dann an die 4 Minuten. Es wird also bei jedem Start langsamer und ich verstehe nicht wieso. Ich vermute, es hat etwas mit den beiden Arrays zu tun. Aber die werden doch nach dem Verlassen der Sub aus dem Speicher gelöscht und beim nächsten Aufruf neu erstellt, oder?

Bin für jeden Tipp dankbar.

Gruß,
Mick

Sub Kalkulation_oneway()

    'VERKAUFSPREIS = PREIS ZU DEM DIE STATION VERKAUFT
    'EINKAUFSPREIS = PREIS ZU DEM DIE STATION KAUFT
    
    'Blatt löschen und Überschriften eintragen
    With Sheets(4)
        .UsedRange.ClearContents
        .Range("A1").Value = "Start"
        .Range("B1").Value = "Ziel"
        .Range("C1").Value = "Ware"
        .Range("D1").Value = "Profit/t "
        .Range("E1").Value = "Profit"
    End With
    
    'Ermittlung der Startwerte
    Anzahl_Stationen = Sheets("Ankauf").Cells(Rows.Count, 1).End(xlUp).Row - 1
    Anzahl_Rohstoffe = Sheets("Ankauf").Cells(1, 256).End(xlToLeft).Column - 1
    MaxProfit = 0
    Kapital = Sheets(1).Range("B1").Value
    Slots = Sheets(1).Range("D1").Value
      
    'Arrays einrichten
    ReDim Einkaufspreis(Anzahl_Stationen, Anzahl_Rohstoffe) As String
    ReDim Verkaufspreis(Anzahl_Stationen, Anzahl_Rohstoffe) As String
    
    'Array Einkaufspreis füllen
    For i = 1 To Anzahl_Stationen
        For j = 1 To Anzahl_Rohstoffe
            Einkaufspreis(i, j) = Sheets("Ankauf").Cells(i + 1, j + 1).Value
        Next j
    Next i
               
    'Array Verkaufspreis füllen
    For i = 1 To Anzahl_Stationen
        For j = 1 To Anzahl_Rohstoffe
            Verkaufspreis(i, j) = Sheets("Verkauf").Cells(i + 1, j + 1).Value
        Next j
    Next i
    
    'Berechnung starten
    For i = 1 To Anzahl_Stationen 'Äußerste Schleife durchläuft alle Stationen (Start)
    
        For k = 1 To Anzahl_Stationen 'Zweite Schleife durchläuft alle Stationen (Ziel)
            
            For j = 1 To Anzahl_Rohstoffe 'Dritte Schleife durchläuft alle Rohstoffe
                    
                'Prüfung, ob ein Verkaufspreis vorhanden ist. Wenn nicht, dann weiter zum nächsten Rohstoff
                If Verkaufspreis(i, j) <> "" Then
                
                    'Prüfung, ob es einen Einkaufspreis gibt. Wenn nicht, dann weiter zum nächsten Rohstoff
                    If Einkaufspreis(k, j) <> "" Then
                    
                        'Möglichen Einkauf berechnen unter Berücksichtigung des Kapitals und der Slots
                        Anzahl_Ware = WorksheetFunction.RoundDown(Kapital / Verkaufspreis(i, j), 0)
                        If Anzahl_Ware > Slots Then
                            Anzahl_Ware = Slots
                        End If
                        
                        Profit = Anzahl_Ware * (Einkaufspreis(k, j) - Verkaufspreis(i, j))
                                            
                        'Prüfung, ob es schon einen besseren Rohstoffdeal gibt. Falls nicht, werden die Werte ausgelesen
                        If MaxProfit < Profit Then
                        MaxProfit = Profit
                        MaxRohstoff = Sheets("Ankauf").Cells(1, j + 1).Value
                        ProfitProT = WorksheetFunction.RoundDown(MaxProfit / Anzahl_Ware, 0)
                        End If
                    End If
                End If
            Next j 'Nächster Rohstoff
                                
                'Falls es einen Rohstoffdeal gibt, wird der beste nun eingetragen
                
                If MaxProfit > 0 Then
                'Neue Zeile einfügen
                        Sheets("Kalkulation2").Rows(2).Insert
                        
                        'Werte speichern
                        Sheets("Kalkulation2").Range("A2").Value = Sheets("Ankauf").Cells(i + 1, 1).Value 'Start
                        Sheets("Kalkulation2").Range("B2").Value = Sheets("Ankauf").Cells(k + 1, 1).Value 'Ziel
                        Sheets("Kalkulation2").Range("C2").Value = Anzahl_Ware & "x " & MaxRohstoff 'Anzahl und Ware
                        Sheets("Kalkulation2").Range("D2").Value = ProfitProT 'Profit
                        Sheets("Kalkulation2").Range("E2").Value = MaxProfit 'Profit
                End If
                
                
                'Variable wieder freigeben
                MaxProfit = 0
                MaxRohstoff = ""
                        
                'Debug Kontrolle um den Fortschritt zu sehen:
                Application.StatusBar = "Von: " & i & " nach " & k
                
        Next k 'Nächste Zielstation
        
    Next i 'Nächste Startstation
    
    'Automatische Spaltenbreite
    Sheets(4).UsedRange.EntireColumn.AutoFit
   
End Sub

 

[FrankR]

Hallo,
schau mal hier:
http://www.herber.de/mailing/vb/html/vastmredim.htm

Auszug:
Vorsicht Die ReDim-Anweisung verhält sich wie eine deklarierende Anweisung, wenn die deklarierte Variable nicht auf Modulebene oder Prozedurebene existiert. Wird eine andere Variable mit dem gleichen Namen später erstellt, sogar in einem größeren Gültigkeitsbereich, so verweist ReDim auf die später erstellte Variable und verursacht nicht unbedingt einen Kompilierungsfehler, auch wenn Option Explicit wirksam ist. Damit solche Konflikte nicht auftreten, sollte ReDim nicht als eine deklarierende Anweisung verwendet werden, sondern nur zur erneuten Dimensionierung von Datenfeldern.

=> vielleicht hilft es schon, die Felder eingangs (mit irgendeiner Größe) zu deklarieren

FrankR

 

[holy_fish]

Überprüf mal ob deine Anzahl_Stationen und _Rohstoffe anwachsen nach jedem durchlauf.

 

[MickH74]

Hab die beiden Arrays bei Workbook open mit

Dim Einkaufspreis (1,1) As String
Dim Verkaufspreis(1,1) As String

deklariert. Leider ohne Besserung.

@holy_fish: Anzahl_Stationen und Anzahl_Rohstoffe sind nicht anwachsend. Die Anzahl wird bei jedem Aufruf richtig ermittelt.

Sonst noch Vorschläge?

Gruß,
Mick

 

[MickH74]

Ich geb hier mal die ganze Datei zum Download frei: http://MickH74.synology.me:7000/fbsharing/diUuBqbp

Nach dem Start das Hinweisfenster ignorieren und auf den Button "Zeige beste Routen" klicken. Nach jedem Klick dauert es länger und länger und länger bis die Berechnung fertig ist.

Vielleicht findet ja jemand heraus woran es liegt. Würde mich wirklich interessieren.

Danke schonmal!
Mick