|
Hallo Zusammen,
nachstehende Funktion funktioniert einwandfrei und macht das was Sie soll.
Jedoch dauert die Abarbeitung des Funktionsaufrufs mit seinen Schleifen und Wiederholungen auf mehreren Tabellenblätteren ziemlich lange.
Evtl hat jemand einen Tipp für mich wie man den Ablauf beschleunige könnte.
Besten Dank
Gruß Stefan
Function NeuBerechnung(StartLine, StartCol)
' Szenario Berechnung
' StMo Vers 2.0
' 2021-11-08
Dim NeuerBestand, Zugang, MonatsVerbrauch, BestandMinusKW, BestandMin, BestandMax As Double
Dim Aktive_Zelle As Variant
Dim n, w, i As Integer
Dim ActWorkSheet As Variant
Dim Merker As String
' Definiere StartPunkt für Berechnungs-Routine
'Aktive_Zelle = ActiveCell.AddressLocal(columnabsolute = True, rowabsolute = True)
'StartCol = wir ignoriert ...
Application.ScreenUpdating = False
' Einschalten der Formelberechnung
Merker = Berechnung()
If Merker = "xlCalculationManual" Then
Application.Calculation = xlCalculationAutomatic
End If
ActWorkSheet = ActiveSheet.Name ' Aktuelle Ansicht zwischen speicheren
StartLine = 35
For w = 1 To 6
' WorkSheet auswählen
ThisWorkbook.Worksheets(w).Activate
For i = 8 To 25 Step 17 ' Beide Spalten aktualisieren
StartCol = i
For n = 35 To 123
' Ziehe Werte
Inventur = ActiveSheet.Cells(n, StartCol - 5).Value
Zugang = ActiveSheet.Cells(n, StartCol - 4).Value
MonatsVerbrauch = ActiveSheet.Cells(2, StartCol - 7).Value
Status = ActiveSheet.Cells(n, StartCol - 3).Value
Szenario = ActiveSheet.Cells(2, StartCol - 1).Value
BestandMin = CInt(ActiveSheet.Cells(30, StartCol - 6).Value)
BestandMax = ActiveSheet.Cells(30, StartCol + 6).Value
'Szenario = "100 % - Save - bestellt, zugesagt"
BestandMinusKW = ActiveSheet.Cells(n - 1, StartCol).Value
If Inventur > 0 And Status <> "Betriebsruhe" Then
NeuerBestand = Round(Inventur - MonatsVerbrauch / 4, 0)
ElseIf Inventur = 0 And Status <> "Betriebsruhe" Then
NeuerBestand = Round(BestandMinusKW - MonatsVerbrauch / 4, 0)
ElseIf Inventur = 0 And Status = "Betriebsruhe" Then
NeuerBestand = BestandMinusKW
End If
If NeuerBestand < 0 Then NeuerBestand = 0
If (Status = "100 % - Save - bestellt, zugesagt" Or _
Status = "Ware eingetroffen") Then
ActiveSheet.Cells(n, StartCol).Value = NeuerBestand + Zugang
Else
ActiveSheet.Cells(n, StartCol).Value = NeuerBestand
End If
'Szenario = "80 % - Hope - Bestellt, Liefertermin unverbindlich"
BestandMinusKW = ActiveSheet.Cells(n - 1, StartCol + 1).Value
If Inventur > 0 And Status <> "Betriebsruhe" Then
NeuerBestand = Round(Inventur - MonatsVerbrauch / 4, 0)
ElseIf Inventur = 0 And Status <> "Betriebsruhe" Then
NeuerBestand = Round(BestandMinusKW - MonatsVerbrauch / 4, 0)
ElseIf Inventur = 0 And Status = "Betriebsruhe" Then
NeuerBestand = BestandMinusKW
End If
If NeuerBestand < 0 Then NeuerBestand = 0
If (Status = "100 % - Save - bestellt, zugesagt" Or _
Status = "Ware eingetroffen" Or _
Status = "80 % - Hope - Bestellt, Liefertermin unverbindlich") Then
BestandMinusKW = ActiveSheet.Cells(n - 1, StartCol + 1).Value
ActiveSheet.Cells(n, StartCol + 1).Value = NeuerBestand + Zugang
Else
ActiveSheet.Cells(n, StartCol + 1).Value = NeuerBestand
End If
'Szenario = "60% - Brave - Bestellt ohne Liefertermin"
BestandMinusKW = ActiveSheet.Cells(n - 1, StartCol + 2).Value
If Inventur > 0 And Status <> "Betriebsruhe" Then
NeuerBestand = Round(Inventur - MonatsVerbrauch / 4, 0)
ElseIf Inventur = 0 And Status <> "Betriebsruhe" Then
NeuerBestand = Round(BestandMinusKW - MonatsVerbrauch / 4, 0)
ElseIf Inventur = 0 And Status = "Betriebsruhe" Then
NeuerBestand = BestandMinusKW
End If
If NeuerBestand < 0 Then NeuerBestand = 0
If (Status = "100 % - Save - bestellt, zugesagt" Or _
Status = "Ware eingetroffen" Or _
Status = "80 % - Hope - Bestellt, Liefertermin unverbindlich" Or _
Status = "60% - Brave - Bestellt ohne Liefertermin") Then
BestandMinusKW = ActiveSheet.Cells(n - 1, StartCol + 2).Value
ActiveSheet.Cells(n, StartCol + 2).Value = NeuerBestand + Zugang
Else
ActiveSheet.Cells(n, StartCol + 2).Value = NeuerBestand
End If
'Szenario = "50 % - Enthiatic - angefragt, aussichtsreich"
BestandMinusKW = ActiveSheet.Cells(n - 1, StartCol + 3).Value
If Inventur > 0 And Status <> "Betriebsruhe" Then
NeuerBestand = Round(Inventur - MonatsVerbrauch / 4, 0)
ElseIf Inventur = 0 And Status <> "Betriebsruhe" Then
NeuerBestand = Round(BestandMinusKW - MonatsVerbrauch / 4, 0)
ElseIf Inventur = 0 And Status = "Betriebsruhe" Then
NeuerBestand = BestandMinusKW
End If
If NeuerBestand < 0 Then NeuerBestand = 0
If (Status = "100 % - Save - bestellt, zugesagt" Or _
Status = "Ware eingetroffen" Or _
Status = "80 % - Hope - Bestellt, Liefertermin unverbindlich" Or _
Status = "60% - Brave - Bestellt ohne Liefertermin" Or _
Status = "50 % - Enthiatic - angefragt, aussichtsreich") Then
BestandMinusKW = ActiveSheet.Cells(n - 1, StartCol + 3).Value
ActiveSheet.Cells(n, StartCol + 3).Value = NeuerBestand + Zugang
Else
ActiveSheet.Cells(n, StartCol + 3).Value = NeuerBestand
End If
'Szenario = "25 % - Faith - angefragt"
BestandMinusKW = ActiveSheet.Cells(n - 1, StartCol + 4).Value
If Inventur > 0 And Status <> "Betriebsruhe" Then
NeuerBestand = Round(Inventur - MonatsVerbrauch / 4, 0)
ElseIf Inventur = 0 And Status <> "Betriebsruhe" Then
NeuerBestand = Round(BestandMinusKW - MonatsVerbrauch / 4, 0)
ElseIf Inventur = 0 And Status = "Betriebsruhe" Then
NeuerBestand = BestandMinusKW
End If
If NeuerBestand < 0 Then NeuerBestand = 0
If (Status = "100 % - Save - bestellt, zugesagt" Or _
Status = "Ware eingetroffen" Or _
Status = "80 % - Hope - Bestellt, Liefertermin unverbindlich" Or _
Status = "60% - Brave - Bestellt ohne Liefertermin" Or _
Status = "50 % - Enthiatic - angefragt, aussichtsreich" Or _
Status = "25 % - Faith - angefragt") Then
BestandMinusKW = ActiveSheet.Cells(n - 1, StartCol + 4).Value
ActiveSheet.Cells(n, StartCol + 4).Value = NeuerBestand + Zugang
Else
ActiveSheet.Cells(n, StartCol + 4).Value = NeuerBestand
End If
'Colors
Select Case Status
Case "100 % - Save - bestellt, zugesagt", "Ware eingetroffen"
ActiveSheet.Cells(n, StartCol - 3).Interior.Color = RGB(0, 255, 0)
ActiveSheet.Cells(n, StartCol - 3).Interior.Color = RGB(0, 255, 0)
Case "80 % - Hope - Bestellt, Liefertermin unverbindlich"
ActiveSheet.Cells(n, StartCol - 3).Interior.Color = RGB(255, 215, 0)
Case "60% - Brave - Bestellt ohne Liefertermin"
ActiveSheet.Cells(n, StartCol - 3).Interior.Color = RGB(255, 140, 0)
Case "50 % - Enthiatic - angefragt, aussichtsreich"
ActiveSheet.Cells(n, StartCol - 3).Interior.Color = RGB(255, 69, 0)
Case "25 % - Faith - angefragt", "Storniert"
ActiveSheet.Cells(n, StartCol - 3).Interior.Color = RGB(255, 69, 0)
Case "Betriebsruhe"
ActiveSheet.Cells(n, StartCol - 3).Interior.Color = RGB(192, 192, 192)
Case ""
ActiveSheet.Cells(n, StartCol - 3).Interior.Color = RGB(255, 255, 255)
End Select
' Korrektur Farbe nach Bestand
For u = 0 To 4
If ActiveSheet.Cells(n, StartCol + u) >= BestandMax Then
ActiveSheet.Cells(n, StartCol + u).Interior.ColorIndex = 6
ElseIf ActiveSheet.Cells(n, StartCol + u) >= BestandMin And ActiveSheet.Cells(n, StartCol + u) < BestandMax Then
ActiveSheet.Cells(n, StartCol + u).Interior.ColorIndex = 4
ElseIf ActiveSheet.Cells(n, StartCol + u) < BestandMax Then
ActiveSheet.Cells(n, StartCol + u).Interior.ColorIndex = 3
End If
Next u
Next n
Next i
Next w
ThisWorkbook.Worksheets(ActWorkSheet).Activate ' Start Tabellenblatt setzen
If Merker = "xlCalculationManual" Then ' Berchnungsmethode zurücksetzten
Application.Calculation = xlCalculationManual
End If
Application.ScreenUpdating = True
End Function
Function Berechnung()
If Application.Calculation = -4105 Then
Berechnung = "xlCalculationAutomatic"
ElseIf Application.Calculation = -4135 Then
Berechnung = "xlCalculationManual"
End If
End Function
|