Thema Datum  Von Nutzer Rating
Antwort
Rot Geschwindigkeits Performance Optimierung
19.11.2021 09:27:36 Stefan
NotSolved
19.11.2021 09:35:40 Gast87139
*****
Solved
19.11.2021 10:09:46 Gast9909
NotSolved
19.11.2021 10:17:44 Gast82781
NotSolved

Ansicht des Beitrags:
Von:
Stefan
Datum:
19.11.2021 09:27:36
Views:
70
Rating: Antwort:
  Ja
Thema:
Geschwindigkeits Performance Optimierung

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

 

 

 


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:

 
 

  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
Rot Geschwindigkeits Performance Optimierung
19.11.2021 09:27:36 Stefan
NotSolved
19.11.2021 09:35:40 Gast87139
*****
Solved
19.11.2021 10:09:46 Gast9909
NotSolved
19.11.2021 10:17:44 Gast82781
NotSolved