Freigeben über

EXCEL VBA: Formel berechnen und Ergebnis als Wert in Zelle schreiben

Anonym
2019-05-17T12:35:08+00:00

hallo,

ich muss in einer Excel-Datei sehr viele Berechnungen durchführen, was sehr viel Berechnungszeit braucht. Ich möchte deshalb die Formeln aus der Datei entfernen, in dem ein Makro die Formel berechnen und das Ergebnis als Wert in die jeweilige Zelle schreiben soll. Leider reichen meine VBA-Kenntnisse dazu nicht aus...

Das Blatt ist so aufgebaut, dass zuerst alle Werte in einer Zeile berechnet werden müssten (von links nach rechts gehend) und dann kommt dasselbe in der nächsten Zeile (besser gesagt 15 Zeilen darunter) dran. Und das bis zur letzten Berechnung in der Zeile 3523. (Ich denke, sowohl Zeilen- als auch Spaltennummern müssten durch Variablen definiert sein - auf die Art cells(i,j) - und die Zellen würden durch eine verschachtelte for/next Schleife für i und j angesteuert.)

Die Formel ist recht umfangreich (wobei manche Werte aus einem anderen Blatt ("xru") kommen, der Rest ist im Berechnungsblatt): 

z.B. in Zelle L13 (da müsste begonnen werden) =SUMME((L3*L8/L6*xru!L$2-K3*K8/K6*xru!K$2)/MITTELWERT(xru!K$2,xru!L$2),(L3*L9/L6*xru!L$3-K3*K9/K6*xru!K$3)/MITTELWERT(xru!K$3,xru!L$3),(L3*L10/L6*xru!L$4-K3*K10/K6*xru!K$4)/MITTELWERT(xru!K$4,xru!L$4),(L3*L11/L6*xru!L$5-K3*K11/K6*xru!K$5)/MITTELWERT(xru!K$5,xru!L$5),(L3*(L6-L8-L9-L10-L11)/L6-K3*(K6-K8-K9-K10-K11)/K6))+(L4*L12-K4*K12)/MITTELWERT(K12,L12)+(L5-K5)

dann als nächstes (alles um eine Spalte versetzt):

in Zelle M13 =SUMME((M3*M8/M6*xru!M$2-L3*L8/L6*xru!L$2)/MITTELWERT(xru!L$2,xru!M$2),(M3*M9/M6*xru!M$3-L3*L9/L6*xru!L$3)/MITTELWERT(xru!L$3,xru!M$3),(M3*M10/M6*xru!M$4-L3*L10/L6*xru!L$4)/MITTELWERT(xru!L$4,xru!M$4),(M3*M11/M6*xru!M$5-L3*L11/L6*xru!L$5)/MITTELWERT(xru!L$5,xru!M$5),(M3*(M6-M8-M9-M10-M11)/M6-L3*(L6-L8-L9-L10-L11)/L6))+(M4*M12-L4*L12)/MITTELWERT(L12,M12)+(M5-L5)

und so weiter in Zeile 13 bis zur letzten Spalte (die letzte Spalte kann ich definieren).

Dann weiter in der nächsten Zeile 15 Zeilen drunter:

in Zelle L28 =SUMME((L18*L23/L21*xru!L$2-K18*K23/K21*xru!K$2)/MITTELWERT(xru!K$2,xru!L$2),(L18*L24/L21*xru!L$3-K18*K24/K21*xru!K$3)/MITTELWERT(xru!K$3,xru!L$3),(L18*L25/L21*xru!L$4-K18*K25/K21*xru!K$4)/MITTELWERT(xru!K$4,xru!L$4),(L18*L26/L21*xru!L$5-K18*K26/K21*xru!K$5)/MITTELWERT(xru!K$5,xru!L$5),(L18*(L21-L23-L24-L25-L26)/L21-K18*(K21-K23-K24-K25-K26)/K21))+(L19*L27-K19*K27)/MITTELWERT(K27,L27)+(L20-K20)

dann wieder Spalte M, und so weiter bis Zeile 3523.

Könnte mir jemand helfen?

(Die For/Next Schleife würde ich noch zusammen bringen, aber ich habe keine Ahnung, wie ich die Formel im Makro in der cells(i,j) Schreibweise darstelle...)

Microsoft 365 und Office | Excel | Für Zuhause | Windows

Gesperrte Frage. Diese Frage wurde aus der Microsoft-Support-Community migriert. Sie können darüber abstimmen, ob sie hilfreich ist, aber Sie können keine Kommentare oder Antworten hinzufügen oder der Frage folgen.

0 Kommentare
Antwort, die vom Frageautor angenommen wurde
  1. Anonym
    2019-05-21T14:27:32+00:00

    Hallo Zoltan,

    ich hoffe, ich habe dich richtig verstanden und die gewünschten Blätter sind im Blatt "Output Sheets" aufgelistet.

    Select, Selection und Activate werden nur in ganz seltenen Fällen benötigt. Wenn man korrekt referenziert, kann darauf verzichtet werden.

    Calculation ist ein Keyword in VBA und diese sollten nicht als Makroname oder Variablen benutzt werden.

    Probiere es mal so:

    Sub Berechnung()

    Dim Spalten As Integer, i As Integer, LRow As Integer, n As Integer

    Dim rngBig As Range, myRow As Range

    Dim varSh As Variant

    With Application

        .ScreenUpdating = False

        .EnableEvents = False

        .Calculation = xlCalculationManual

    End With

    On Error GoTo CleanUp

    With Sheets("Output Sheets")

        LRow = .Cells(.Rows.Count, "A").End(xlUp).Row

        varSh = .Range("A1:A" & LRow)

    End With

    For n = LBound(varSh) To UBound(varSh)

        With Sheets(varSh(n, 1))

            'Hier die Spalten f?r die Formeln anpassen

            Set rngBig = Nothing

            Spalten = .Columns("CI").Column - .Columns("L").Column + 1

            For i = 13 To 3523 Step 15

                If rngBig Is Nothing Then

                    Set rngBig = .Cells(i, "L").Resize(1, Spalten)

                Else

                    Set rngBig = Union(rngBig, .Cells(i, "L").Resize(1, Spalten))

                End If

            Next

            With rngBig

                .Formula = "=IFERROR(SUM((L3*L8/L6*xru!L$2-K3*K8/K6*xru!K$2)/Average(xru!K$2,xru!L$2)," _

                    & "(L3*L9/L6*xru!L$3-K3*K9/K6*xru!K$3)/Average(xru!K$3,xru!L$3)," _

                    & "(L3*L10/L6*xru!L$4-K3*K10/K6*xru!K$4)/Average(xru!K$4,xru!L$4)," _

                    & "(L3*L11/L6*xru!L$5-K3*K11/K6*xru!K$5)/Average(xru!K$5,xru!L$5)," _

                    & "(L3*(L6-L8-L9-L10-L11)/L6-K3*(K6-K8-K9-K10-K11))/K6+(L4*L12-K4*K12)/Average(K12,L12)" _

                    & "+(L5-K5)),0)"

                .Calculate

                For Each myRow In rngBig

                    With myRow

                        .Value = .Value

                    End With

                Next

            End With

        End With

    Next

    CleanUp:

    With Application

        .Calculation = xlCalculationAutomatic

        .EnableEvents = True

        .ScreenUpdating = True

    End With

    End Sub

    Claus

    2 Personen fanden diese Antwort hilfreich.
    0 Kommentare

11 zusätzliche Antworten

Sortieren nach: Am hilfreichsten
Am hilfreichsten Neueste Älteste
  1. Anonym
    2019-05-21T06:42:19+00:00

    Lieber Claus,

    Danke für deine Antwort. Habe heute versucht, das Makro zu implementieren. Dabei hat sich folgendes Problem ergeben: Ich importiere die Daten aus einer Datenbank mit nicht durchgängigen Daten (was davon kommt, dass es sich um Forderungsbestände in verschiedenen Währungen handelt und in manchen Quartalen ist der Wert eben Null oder fehlend). In diesen Fällen Stürzt das Makro ab, (vermutlich) weil beim entsprechenden Summand wegen dem Null- oder Fehlwert der Bruch in der Formel nicht berechnet werden kann. Gäbe es einen Weg für eine Modifikation, so dass wenn der Summand nicht berechnet werden kann (einen Fehler liefert) er einfach 0 gesetzt wird?

    LG, Zoltan

    0 Kommentare
  2. Anonym
    2019-05-21T06:09:15+00:00

    Lieber Claus, lieber Andreas,

    vielen Dank für die Lösungsvorschläge bzw. Hinweise. Ich komme erst heute zur Umsetzung. Werde halt ausprobieren und schauen wie das Makro läuft... Eventuell muss ich mich wirklich um eine andere Lösung (möglicherweise nicht im Excel) kümmern.

    LG, Zoltan

    0 Kommentare
  3. Andreas Killer 144.1K Zuverlässigkeitspunkte Freiwilliger Moderator
    2019-05-17T16:18:57+00:00

    (Die For/Next Schleife würde ich noch zusammen bringen, aber ich habe keine Ahnung, wie ich die Formel im Makro in der cells(i,j) Schreibweise darstelle...)

    Naja, kannst Du zwar machen, Claus hat ja schon ein Beispiel gezeigt. Aber bringen wird es nichts, wahrscheinlich sogar das Gegenteil bewirken.

    Die Berechnungszeit einer Formel ist immer schneller als ein Makro, weil die Berechnungsengine in Excel einen direkten Zugriff auf die Daten hat. Allein das Laden und übergeben der Daten an VBA dauert da schon länger. Bei vielen Formeln die immer andere Zellen als Eingabe haben gibt daher keinen Vorteil.

    Nur wenn viele Formeln immer wieder die gleichen Zellen als Eingabe haben (wenn man z.B. eine Suche durchführt oder einen Mittelwert bildet), dann hat man mit einem Makro einen Vorteil, weil man diese Aktion nur einmal ausführen muss und das Ergebnis in einer Variablen speichern und wieder verwerten kann.

    Hier ist ein detaillierter Artikel dazu

    https://msdn.microsoft.com/en-us/library/office/ff700515(v=office.14).aspx

    Andreas.

    0 Kommentare
  4. Anonym
    2019-05-17T15:02:18+00:00

    Hallo Zoltan,

    probiere es mal so (Spalten musst du noch anpassen):

    Sub Berechnung()

    Dim Summand1 As Double, Summand2 As Double, Summand3 As Double

    Dim Summand4 As Double, Summand5 As Double

    Dim n As Integer, i As Integer

    With Application

        For i = 13 To 3523 Step 15

            For n = Columns("L").Column To Columns("S").Column

                Summand1 = (Cells(i - 10, n) * Cells(i - 5, n) / Cells(i - 7, n) * _

                    Sheets("xru").Cells(2, n) - Cells(i - 10, n - 1) * Cells(i - 5, n - 1) _

                    / Cells(i - 7, n - 1) * Sheets("xru").Cells(2, n - 1)) / _

                    .Average(Sheets("xru").Cells(2, n - 1), Sheets("xru").Cells(2, n))

                Summand2 = (Cells(i - 10, n) * Cells(i - 4, n) / Cells(i - 4, n) * _

                    Sheets("xru").Cells(3, n) - Cells(i - 10, n - 1) * Cells(i - 4, n - 1) / _

                    Cells(i - 7, n - 1) * Sheets("xru").Cells(i - 10, n - 1)) / _

                    .Average(Sheets("xru").Cells(i - 10, n - 1), Sheets("xru").Cells(i - 10, n))

                Summand3 = (Cells(i - 10, n) * Cells(i - 3, n) / Cells(i - 7, n) * _

                    Sheets("xru").Cells(4, n) - Cells(i - 10, n - 1) * Cells(i - 3, n - 1) _

                    / Cells(i - 7, n - 1) * Sheets("xru").Cells(4, n - 1)) / _

                    .Average(Sheets("xru").Cells(4, n - 1), Sheets("xru").Cells(4, n))

                Summand4 = (.Cells(i - 10, n) * Cells(i - 2, n) / Cells(i - 7, n) * _

                    Sheets("xru").Cells(5, n) - Cells(i - 10, n - 1) * Cells(i - 2, n - 1) / _

                    Cells(i - 7, n - 1) * Sheets("xru").Cells(5, n - 1)) / _

                    .Average(Sheets("xru").Cells(5, n - 1), Sheets("xru").Cells(5, n))

                Summand5 = (Cells(i - 10, n) * (Cells(i - 7, n) - Cells(i - 5, n) - Cells(i - 4, n) - _

                    Cells(i - 3, n) - Cells(i - 2, n)) / (Cells(i - 7, n) - Cells(i - 10, n - 1) * _

                    (Cells(i - 7, n - 1) - Cells(i - 5, n - 1) - Cells(i - 4, n - 1) - Cells(i - 3, n - 1) _

                    - Cells(i - 2, n - 1)) / Cells(i - 7, n - 1)) / Cells(i - 7, n - 1)) + _

                    (Cells(i - 9, n) * Cells(i - 1, n) - Cells(i - 9, n - 1) * Cells(i - 1, n - 1)) _

                    / .Average(Sheets("xru").Cells(i - 1, n - 1), Sheets("xru").Cells(i - 1, n)) _

                    + (Cells(i - 8, n) - Cells(i - 8, n - 1))

                Cells(i, n) = Summand1 + Summand2 + Summand3 + Summand4 + Summand5

            Next

        Next

    End With                

    End Sub

    Claus

    0 Kommentare