| VB 4/6- und VBA-Forum - Beitragsübersicht - |
|
| Von |
MickH74 |
| Datum |
28. Juni 2015 um 20:41:01 |
| Frage |
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?
Während diese Sub läuft wird noch ein Statusbalken eingeblendet, der mit DoEvents am Leben gehalten wird. Vielleicht hat es auch damit etwas zu tun?
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 |
|
Zum Seitenanfang