Microsoft Excel

Herbers Excel/VBA-Archiv

Script wird nach jedem Durchlauf langsamer

Betrifft: Script wird nach jedem Durchlauf langsamer von: MickH74
Geschrieben am: 27.06.2015 19:05:36

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.





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

  

Betrifft: AW: Script wird nach jedem Durchlauf langsamer von: Bernd
Geschrieben am: 27.06.2015 20:10:05

Versuche mal zu beginn folgenden Eintrag:

Option Explicit
Dim Einkaufspreis, Verkaufspreis

Sub Kalkulation_oneway()

Einkaufspreis = Array() 
Verkaufspreis = Array()

...



Gruß,
Bernd


  

Betrifft: AW: Script wird nach jedem Durchlauf langsamer von: MickH74
Geschrieben am: 27.06.2015 20:44:05

Hallo Bernd,

das hilft leider nicht.

Sonst noch eine Idee?

Gruß,
Mick


  

Betrifft: AW: Script wird nach jedem Durchlauf langsamer von: MickH74
Geschrieben am: 28.06.2015 20:51:10

Ich geb hier mal die ganze Datei zum Download frei: https://www.herber.de/bbs/user/98532.xlsm

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


 

Beiträge aus den Excel-Beispielen zum Thema "Script wird nach jedem Durchlauf langsamer"