Code schneller machen

Sub Optimize() Dim noCells As Integer Dim highDemandRow As Integer Dim sumCheck As Integer With Application .ScreenUpdating = False .EnableEvents = False .Calculation = xlAutomatic .MaxChange = 0.001 .StatusBar = True End With Worksheets("DATA").Select noCells = WorksheetFunction.CountA(Range(Cells(3, 68), Cells(3, 68).End(xlDown))) Range(Cells(3, 9), Cells(noCells + 2, 9)).ClearContents Range(Cells(3, 11), Cells(noCells + 2, 11)).ClearContents For i = 1 To noCells sumCheck = WorksheetFunction.Sum(Range("BQ:BQ")) Columns("BP:BP").Select Columns("BP:BP").Find(What:=i, After:=ActiveCell, LookIn:=xlValues, LookAt:= _ xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True _ , SearchFormat:=False).Select On Error Resume Next highDemandRow = Selection.row Application.StatusBar = "Completed " & i & " of " & noCells & " hours" If (sumCheck = 0) Then If (Cells(highDemandRow, 10) > 0) Then If Cells(highDemandRow, 10) >= Cells(highDemandRow, 8) Then Cells(highDemandRow, 9).Value = Cells(highDemandRow, 8) Cells(highDemandRow, 11).Value = Cells(highDemandRow, 8) Else Cells(highDemandRow, 9).Value = Cells(highDemandRow, 10) Cells(highDemandRow, 11).Value = Cells(highDemandRow, 10) End If End If Else Columns("BP:BP").Find(What:=(i - 1), After:=ActiveCell, LookIn:=xlValues, LookAt:= _ xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True, SearchFormat:=False).Select highDemandRow = Selection.row Range(Cells(highDemandRow, 9), Cells(highDemandRow, 9)).ClearContents Range(Cells(highDemandRow, 11), Cells(highDemandRow, 11)).ClearContents End If Next i Application.StatusBar = "" With Application .ScreenUpdating = True .Calculation = xlAutomatic .StatusBar = False End With End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Mylady (da schließe ich mich Luc an),
9000 Zeilen zu durchlaufen dauert numal seine Zeit. Ich hab mal die paar Selects rausgenommen, die Refernenzierung verbessert und ein paar Artefakte entfernt. Vielleicht bringt das schon was.

Sub Optimize()
Dim noCells As Integer
Dim highDemandRow As Integer
Dim sumCheck As Integer
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlAutomatic
.MaxChange = 0.001
.StatusBar = True
End With
With Worksheets("DATA")
noCells = WorksheetFunction.CountA(.Range(.Cells(3, 68), .Cells(3, 68).End(xlDown)))
.Range(.Cells(3, 9), .Cells(noCells + 2, 9)).ClearContents
.Range(.Cells(3, 11), .Cells(noCells + 2, 11)).ClearContents
sumCheck = WorksheetFunction.Sum(.Range("BQ:BQ"))
For i = 1 To noCells
On Error Resume Next
highDemandRow = .Columns("BP:BP").Find(What:=i, LookIn:=xlValues, LookAt:=xlWhole).Row
Application.StatusBar = "Completed " & i & " of " & noCells & " hours"
If (sumCheck = 0) Then
If (.Cells(highDemandRow, 10).Value > 0) Then
If .Cells(highDemandRow, 10).Value >= .Cells(highDemandRow, 8) Then
.Cells(highDemandRow, 9).Value = .Cells(highDemandRow, 8).Value
.Cells(highDemandRow, 11).Value = .Cells(highDemandRow, 8).Value
Else
.Cells(highDemandRow, 9).Value = .Cells(highDemandRow, 10).Value
.Cells(highDemandRow, 11).Value = .Cells(highDemandRow, 10).Value
End If
End If
Else
highDemandRow = .Columns("BP:BP").Find(What:=i - 1, LookIn:=xlValues, LookAt:= _
xlWhole).Row
.Cells(highDemandRow, 9).ClearContents
.Cells(highDemandRow, 11).ClearContents
End If
Next i
Application.StatusBar = ""
End With
With Application
.ScreenUpdating = True
.Calculation = xlAutomatic
.StatusBar = False
End With
End Sub

deine Prüfung
sumCheck = WorksheetFunction.Sum(Range("BQ:BQ"))
begreife ich vom Logikverständniss her nicht. In BQ wird das ganze Makro über nichts geändert, warum prüfst du das jedes mal neu? An Formelbeziehungen kann es nicht liegen, denn du hast die Auto-Berechnung ausgeschaltet. Hab ich über die Schleife gehoben.
HighDemandRow holst du dir zweimal, kann sich aber in der Zeit nicht geändert haben. Einmal für i, einmal für i-1. Solltest du, allein wegen der Übersichtlichkeit, anders machen. Vielleicht eine zweite Variable einführen?
Weiteres Potential kann ich erstmal nicht sehen, da ich ja auch deine Masterdatei nicht kenne.
Grüße,
Klaus M.vdT.

Hallo Klaus,
vielen Dank zunächst einmal :)
Nun zum Code: In der Reihe sumCheck = WorksheetFunction.Sum(Range("BQ:BQ") geht es darum zu prüfen, ob meine Werte in Column 10 jemals negativ werden, denn das dürfen sie nicht. Und da diese Optimierung, beginnend vom höchsten Demand (welchen ich in BP descending geranked habe), immer wieder Werte einfügt (in Col 9 und 11) und somit die Menge ändert, ist es wichtig zu prüfen, ob meine Werte auch positiv bleiben.
Das mache ich mit sumCheck, denn wenn die Werte positiv sind, ist eine "0" deklariert. Sind sie negativ ist eine "1" deklariert. Das heisst nur solange SumCheck=0 ist soll die Optimierung funktionieren.
Gehen die Werte ins negative, folgt ClearContent und er macht weiter, da zwischendrin immer wieder neu hinzugefügte Menge kommt. Zur Info: Ich schreibe meine Masterarbeit und optimiere ein Staumdamm dazu :// (Column 10 ist Wassermenge, welche steigt aber nach Nutzung sinkt und BP ist die gerankte Nachfrage beginnend vom höchsten Wert, BQ prüft mit den Nullen, ob bei jedem Vorgang wir auch noch positiv Wasser verfügen).
Wenn ich den Code auf .Calculation = xlCalculationManual setze, dann läuft Column 10 (wasser) ins negative.
Dein Code läuft übrigens gerade nebenbei, leider noch auf automatic und daher langsam. Aber mal schauen, ob es diesmal weniger als 45 min dauert.
Vielen Dank!!
Grüße,
Mylady (sehr höflich von euch) :)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

16 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Code schneller machen

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

16 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread