Excel (Physikalische) Formeln per VBA berechnen lassen

new Account()

Banned
Dabei seit
Mai 2018
Beiträge
7.199
4. Suche in meiner VBA-Liste mit allen Formeln nach der Formel P_elektrisch

5. Schaue, was für Eingangsgrößen für die Berechnung von P_elektrisch benötigt werden -> U und I

Nimm ein Dictionary (key->Value-Mapping):
Der Key ist der Name der Formel
Value ist ein Objekt eines Typs (den du erstellst) mit den folgenden Membern:
1) Liste von strings, welche die Argumente der Funktion beschreibt (z.b. ["U", "I"])
2) Lambda Ausdruck mit der Signatur (inputlist) -> double

Das lambda schaut dann z.B. so aus:
Code:
Function P_mechanisch(inputlist)
    Dim n: n = inputlist(1)
    Dim M: M = inputlist(2)
    Dim Pi: Pi = WorksheetFunction.Pi
    P_mechanisch = n * M * 2 * Pi / 60 / 1000
End Function

Die Liste von strings ist dann ["n", "M"]


Das Vorghen ist dann insgesamt.
1. Initialisiere Dictionary mit allen Funktionen.
2. lese Formelnamen aus
3. hole Objekt für den spezifischen Namen aus dem Dictionary
4. lese die liste von strings aus dem Objekt aus
5. suche die werte für die jeweiligen bezeichnungen (z.B. "U") aus der Excel tabelle und speichere sie in der inputlist
6. rufe das lambda des objekts auf und übergebe die inputlist

PS: Wenn alle Funktionen immer 2 Argumente haben, könnte man es noch etwas optimieren
PPS: Mit Reflection könnte man das ggf. noch etwas tweaken (und die liste von Strings und damit auch den neuen Typen weglassen)
 
Zuletzt bearbeitet:

tollertyp

Captain
Dabei seit
Feb. 2020
Beiträge
3.161
Nicht elegant, aber berechnet, wenn sich etwas in den Rohdaten ändert. Dazu in den Code von Rohdaten (Tabelle1) legen:

Code:
Private Const Rohdaten = "Rohdaten"
Private Const Formeln = "Formeln"

Private Sub Worksheet_Change(ByVal Target As Range)
    If Range(Target.Address).Column > 1 And Range(Target.Address).Row > 2 And Cells(Range(Target.Address).Row, 1).value <> "" And Cells(1, Range(Target.Address).Column).value <> "" Then
        calculateRow Range(Target.Address).Row
    End If
End Sub

Private Sub calculateRow(ByVal Rohdaten_Row As Integer)
    Dim Nr As Integer
    Nr = Worksheets(Rohdaten).Cells(Rohdaten_Row, 1)
    
    Dim Formel_Col
    Formel_Col = findTargetCol(Nr)
    If Formel_Col < 0 Then
        Exit Sub
    End If
    
    Dim Formel_Row As Integer
    Formel_Row = 2
    Dim Formel
    While Formel_Row < 32767 ' Integer max value
        Formel = Worksheets(Formeln).Cells(Formel_Row, 1).value
        If (Formel = "") Then
            Exit Sub
        End If
        
        Worksheets(Formeln).Cells(Formel_Row, Formel_Col).value = CallByName(Worksheets(Rohdaten), Formel, VbMethod, Rohdaten_Row)
        Formel_Row = Formel_Row + 1
    Wend
End Sub

Private Function findTargetCol(Nr As Integer) As Integer
    Dim Column As Integer
    Dim value
    Column = 3     ' start in column 3
        
    While Column < 32767 ' Integer max value
        value = Worksheets(Formeln).Cells(1, Column).value
        If (value = Nr) Then
            findTargetCol = Column
            Exit Function
        End If
        If (value = "") Then
            findTargetCol = -1
            Exit Function
        End If
        Column = Column + 1
    Wend
End Function

Function P_mechanisch(Rohdaten_Row As Integer) As Double
    Dim Pi, n, M
    Pi = WorksheetFunction.Pi
    n = getVar(Rohdaten_Row, "n")
    M = getVar(Rohdaten_Row, "M")
    
    P_mechanisch = n * M * 2 * Pi / 60 / 1000
End Function

Function P_elektrisch(Rohdaten_Row As Integer) As Double
    Dim U, I
    U = getVar(Rohdaten_Row, "U")
    I = getVar(Rohdaten_Row, "I")
       
    P_elektrisch = U * I / 1000
End Function

Function getVar(Rohdaten_Row As Integer, var As String)
    Dim Column As Integer
    Dim value
    Column = 2 ' start in column 2
    While Column < 32767 ' Integer max value
        value = Worksheets(Rohdaten).Cells(1, Column).value
        If (value = var) Then
            getVar = Worksheets(Rohdaten).Cells(Rohdaten_Row, Column)
            Exit Function
        End If
        If (value = "") Then
            getVar = -1
            MsgBox "No Value for " & Rohdaten_Row & " / " & var
            Exit Function
        End If
        Column = Column + 1
    Wend
End Function

Es bestimmt die Zelle, die sich geändert hat, und berechnet dann für diese Zeile die neuen Werte.
Man kann die Methode zum Berechnen der Zeile natürlich auch aus anderen "Gründen" aufrufen... (z.B. beim Verlassen des Tabs könnte man alle Werte berechnen)

Code:
Private Sub Worksheet_Deactivate()
    Dim Rohdaten_Row As Integer
    Rohdaten_Row = 3
    While Rohdaten_Row < 32767 ' Integer max value
        If (Worksheets(Rohdaten).Cells(Rohdaten_Row, 1).value = "") Then
            Exit Sub
        End If
        calculateRow Rohdaten_Row
        
        Rohdaten_Row = Rohdaten_Row + 1
    Wend
End Sub
Dann wird die Worksheet_Change natürlich nicht mehr benötigt.

Ist es schön? Keine Ahnung...
Kann man sicher schöner machen.
 

tollertyp

Captain
Dabei seit
Feb. 2020
Beiträge
3.161
Etwas kompakter... reagiert nur noch auf Sheet-Wechsel.
Code:
-- siehe Code unten --

Dieselbe Frage in mehreren Foren stellen ist genauso eine Unart wie mehrere Threads mit der gleichen Frage. Ich bin damit raus.

Ach ja, es löscht keine Werte raus.

Excel blockiert bei mir grob pro Rohdaten-Zeile für 1ms.

Edit:
Hier nochmal mit den Change-Event. Wer kein Change-Event will sondern den Deactive, der entfernt die Change-Methode und ruft recalculateAll in Worksheet_Deactivate auf. Analog könnte stattdessen recalculateAll auch von einem Button oder anderen Event aufgerufen werden.
Code:
Private Const Rohdaten = "Rohdaten"
Private Const Formeln = "Formeln"

Private Sub Worksheet_Change(ByVal Target As Range)
    If Range(Target.Address).Column > 1 And Range(Target.Address).Row > 2 And Cells(Range(Target.Address).Row, 1).value <> "" And Cells(1, Range(Target.Address).Column).value <> "" Then
         calculateRow Range(Target.Address).Row
    End If
End Sub

Private Sub Worksheet_Deactivate()
    ' recalculateAll
End Sub

Private Sub recalculateAll()
    Dim Rohdaten_Row As Integer
    Rohdaten_Row = 3
    While Worksheets(Rohdaten).Cells(Rohdaten_Row, 1).value <> ""
        calculateRow Rohdaten_Row
        Rohdaten_Row = Rohdaten_Row + 1
    Wend
End Sub

Private Sub calculateRow(ByVal Rohdaten_Row As Integer)
    Dim data
    Set data = CreateObject("Scripting.Dictionary")
    
    Dim Column As Integer
    Column = 1
    While Worksheets(Rohdaten).Cells(1, Column).value <> ""
        data.Add Worksheets(Rohdaten).Cells(1, Column).value, Worksheets(Rohdaten).Cells(Rohdaten_Row, Column).value
        Column = Column + 1
    Wend
    calculateRowWithData Rohdaten_Row, data
End Sub

Private Sub calculateRowWithData(ByVal Formel_Col As Integer, ByVal data)
    Worksheets(Formeln).Cells(1, Formel_Col).value = data("Nr.")
    
    Dim Formel
    Dim Formel_Row As Integer
    Formel_Row = 2
    While Worksheets(Formeln).Cells(Formel_Row, 1).value <> ""
        Formel = Worksheets(Formeln).Cells(Formel_Row, 1).value
        Worksheets(Formeln).Cells(Formel_Row, Formel_Col).value = CallByName(Worksheets(Rohdaten), Formel, VbMethod, data)
        Formel_Row = Formel_Row + 1
    Wend
End Sub

Function P_mechanisch(data) As Double
    Dim Pi, n, M
    Pi = WorksheetFunction.Pi
    n = data("n")
    M = data("M")
    
    P_mechanisch = n * M * 2 * Pi / 60 / 1000
End Function

Function P_elektrisch(data) As Double
    Dim U, I
    U = data("U")
    I = data("I")
       
    P_elektrisch = U * I / 1000
End Function
 
Zuletzt bearbeitet:

Sebbl1990

Cadet 4th Year
Ersteller dieses Themas
Dabei seit
Okt. 2008
Beiträge
122

Na ganz einfach - es gibt ja auch noch ein Leben außerhalb von Excel. Wenn ich auf Beiträge antworte, dann möchte ich mir auch die Zeit nehmen und verstehen, was mir genau vorgeschlagen wurde.

Das habe ich bei tollertyps Lösung jetzt gemacht: Ich bin mir sicher, wenn irgendjemand bei der Suche nach einer Lösung für ein ähnlich gelagertes Problem den Thread findet, dann wird das für sehr viele eine gangbare Lösung sein.
Ich finde es auf den ersten Blick auch vom Stil sehr gut programmiert. Klar, auf den individuellen Fall anpassen und hier und da etwas noch eleganter machen, geht meistens. Aber das liegt dann auch in den Händen des Nutzers.

Für meinen speziellen Fall hat die Lösung einen Nachteil - ich muss bei jeder Formel = Function nochmal die Eingangsgrößen expilzit aufführen. Das führt zu sehr vielen Dopplungen (einige Eingangsgrößen gehen in sehr viele Formeln ein). Das ist freilich aus meinem einfachen Beispiel mit den 2 Formeln nicht zu erkennen.


Ich bin an einer für mich passenden Lösung - die ich natürlich gerne abschließend auch teile - schon nahe dran und mir fehlt nur noch ein "Puzzlestück" damit es funktioniert:

Ich habe meinen Code jetzt soweit, dass ich an einer Stelle alle nötigen Eingangsgrößen und Konstanten als Variablen initialisiere und für eine beliebige Messreihe die Messwerte diesen Variablen zuweise. Das ist mit wenig Aufwand um weitere Eingangsgrößen erweiterbar.

Desweiteren wird eine beliebige Formeln (z.B. P_elektrisch) für diese Messreihe errechnet und in eine öffentliche Variable mit eben diesem Namen geschrieben. Für eine Messreihe X ist dann also beispielsweise die Variable P_elektrisch = 123,4.

Die Liste der Formeln kann ich auch ganz einfach erweitern, das klappt genauso wie ich mir das vorgestellt habe.

Im Ziel-Tabellenblatt "Formeln" kann ich auch ganz einfach die Spalte A (also meine Liste an Formeln) auslesen und von oben nach unten durchgehen, das ist ja kein Hexenwerk.

Das einzige, was mir noch fehlt und was vielleicht ganz einfach lösbar ist: Ich lese die Spalte A aus und bekomme z.B. für Zeile 3 einen String "P_elektrisch" zurück. Wie sage ich dem VBA jetzt, dass er die Variable, die genau diesem String entspricht, in meine Zielzelle (z.B. C3) schreiben soll?

Vielen Dank schon mal für alle Beiträge, ich denke, da sind viele nutzbare und für verschiedene Anwendungsszenarien geeignete Lösungsmöglichkeiten schon genannt und erläutert worden!

Viele Grüße
Sebastian
 

tollertyp

Captain
Dabei seit
Feb. 2020
Beiträge
3.161
Für meinen speziellen Fall hat die Lösung einen Nachteil - ich muss bei jeder Formel = Function nochmal die Eingangsgrößen expilzit aufführen. Das führt zu sehr vielen Dopplungen (einige Eingangsgrößen gehen in sehr viele Formeln ein). Das ist freilich aus meinem einfachen Beispiel mit den 2 Formeln nicht zu erkennen.
Ich gehe davon aus, du meinst diese Blöcke hier:
Code:
    Dim Pi, n, M
    Pi = WorksheetFunction.Pi
    n = data("n")
    M = data("M")
und
Code:
    Dim U, I
    U = data("U")
    I = data("I")

Natürlich ist das nicht schön. Aber es ist die einfache Folge von dem, was du anfangs gerne gehabt hättest:
Die Berechnungsformeln (P_mechanisch und P_elektrisch im Beispiel) möchte ich im VBA unterbringen, damit ich dort die Formeln in einfach lesbarer Form haben kann. (z.B. P_elektrisch = U * I / 1000 - siehe unten)

Also irgendwo müssen die Variablen "definiert" sein, damit sie von deiner Formel genutzt werden können.
Da Reflection (was entgegen der Aussage von @new Account() in VBA nicht funktioniert) keine Möglichkeit ist, fällt leider auch die dynamische Parameterisierung von Funktionen weg. Mit Reflection würde ich es z.B. so machen... aber wie gesagt: Das geht nicht:
Code:
...
    Formel = Worksheets(Formeln).Cells(Formel_Row, 1).value
    ParameterTypen = getParameterTypen(Formel)
    ParameterFuerFormel = getParameterTypen(ParameterTypen, data)

    Worksheets(Formeln).Cells(Formel_Row, Formel_Col).value = CallByName(Worksheets(Rohdaten), Formel, VbMethod, ParameterFuerFormel)
...

Function P_mechanisch(n, M, Pi) As Double
    P_mechanisch = n * M * 2 * Pi / 60 / 1000
End Function

Function P_elektrisch(U, I) As Double
    P_elektrisch = U * I / 1000
End Function

Meine Lösung wäre vermutlich dann, die Formeln gar nicht im VBA zu haben, sondern in einem eigenen Sheet:
1598452454136.png


Der Code dazu:
Code:
Private Const Sheet_Rohdaten = "Rohdaten"
Private Const Sheet_Formeln = "Formeln"
Private Const Sheet_Formeldefinitionen = "Formeldefinitionen"

Private Sub Worksheet_Change(ByVal Target As Range)
    If Range(Target.Address).Column > 1 And Range(Target.Address).Row > 2 And Cells(Range(Target.Address).Row, 1).value <> "" And Cells(1, Range(Target.Address).Column).value <> "" Then
        Dim Formeln
        Set Formeln = CreateObject("Scripting.Dictionary")
        initialisiereFormeln Formeln
        calculateRow Range(Target.Address).Row, Formeln
    End If
End Sub

Private Sub Worksheet_Deactivate()
    ' recalculateAll
End Sub

Private Sub recalculateAll()
    Dim Formeln
    Set Formeln = CreateObject("Scripting.Dictionary")
    initialisiereFormeln Formeln

    Dim Rohdaten_Row As Long
    Rohdaten_Row = 3
    While Worksheets(Sheet_Rohdaten).Cells(Rohdaten_Row, 1).value <> ""
        calculateRow Rohdaten_Row, Formeln
        Rohdaten_Row = Rohdaten_Row + 1
    Wend
End Sub

Private Sub initialisiereFormeln(ByRef Formeln)
    Dim Row As Long
    Row = 2
    While Worksheets(Sheet_Formeldefinitionen).Cells(Row, 1).value <> ""
        Formeln.Add Worksheets(Sheet_Formeldefinitionen).Cells(Row, 1).value, Worksheets(Sheet_Formeldefinitionen).Cells(Row, 2).value
        Row = Row + 1
    Wend
End Sub

Private Sub calculateRow(ByVal Rohdaten_Row As Long, ByRef Formeln)
    Dim data
    Set data = CreateObject("Scripting.Dictionary")

    Dim Column As Long
    Column = 1
    While Worksheets(Sheet_Rohdaten).Cells(1, Column).value <> ""
        data.Add Worksheets(Sheet_Rohdaten).Cells(1, Column).value, Worksheets(Sheet_Rohdaten).Cells(Rohdaten_Row, Column).value
        Column = Column + 1
    Wend

    ' Konstanten hinzufügen
    data.Add "Pi", WorksheetFunction.Pi
    calculateRowWithData Rohdaten_Row, data, Formeln
End Sub

Private Sub calculateRowWithData(ByVal Formel_Col As Long, ByRef data, ByRef Formeln)
    Static re As Object

    If re Is Nothing Then
        Set re = CreateObject("VBScript.RegExp")
        re.Global = True
        re.MultiLine = True
        re.Pattern = "[a-zA-Z_]+"
    End If
   
    Worksheets(Sheet_Formeln).Cells(1, Formel_Col).value = data("Nr.")

    Dim Formelname, value
    Dim Formel As String
    Dim Formel_Row As Long
    Formel_Row = 2
    While Worksheets(Sheet_Formeln).Cells(Formel_Row, 1).value <> ""
        Formelname = Worksheets(Sheet_Formeln).Cells(Formel_Row, 1).value
        Formel = Formeln(Formelname)
   
        Dim ctr As Long
        ctr = 1
        Set matches = re.Execute(Formel)
        For Each Match In matches
            value = data("" & Match)
            value = Replace(value, ",", ".")
            Formel = Replace(Formel, Match, value)
            ctr = ctr + 1
        Next Match

        value = Application.Evaluate(Formel)
        Worksheets(Sheet_Formeln).Cells(Formel_Row, Formel_Col).value = value
   
        ' Berechneten Wert unter dem Formelname merken
        data.Add Formelname, value
        Formel_Row = Formel_Row + 1
    Wend
End Sub

Damit könnte man dann sogar sowas machen als Formel-Definitionen:
NameFormel
P_mechanischn * M * 2 * Pi / 60 / 1000
P_elektrischU * I / 1000
P_quatschP_mechanisch * P_elektrisch

und würde das hier erhalten (Die Reihenfogle ist hier aber wichtig):
1​
2​
3​
4​
P_mechanischkW
1,29224178​
3,70079615​
7,26126782​
3,14159265​
P_elektrischkW
23,05​
22​
14,4​
22​
P_quatsch
29,786173​
81,4175152​
104,562257​
69,1150384​

Das einzige, was mir noch fehlt und was vielleicht ganz einfach lösbar ist: Ich lese die Spalte A aus und bekomme z.B. für Zeile 3 einen String "P_elektrisch" zurück. Wie sage ich dem VBA jetzt, dass er die Variable, die genau diesem String entspricht, in meine Zielzelle (z.B. C3) schreiben soll?
Das verstehe ich ehrlich gesagt nicht?
 

new Account()

Banned
Dabei seit
Mai 2018
Beiträge
7.199
(was entgegen der Aussage von @new Account() in VBA nicht funktioniert)
1. Ich habe nicht behauptet, dass Reflection geht
2. Stimmt nicht ganz - manches geht:
https://stackoverflow.com/questions/14200535/parsing-vba-module-function-parameters-via-reflection
https://stackoverflow.com/questions/1892039/iterating-through-the-object-browser-in-vba

Auch du verwendest quasi schon Reflection via CallByName: https://docs.microsoft.com/de-de/of...rence/user-interface-help/callbyname-function (durch welches man in der Tat das Dictionary in meinem Lösungsansatz einspart)
 

Sebbl1990

Cadet 4th Year
Ersteller dieses Themas
Dabei seit
Okt. 2008
Beiträge
122
Meine Lösung wäre vermutlich dann, die Formeln gar nicht im VBA zu haben, sondern in einem eigenen Sheet:
Anhang 959057 betrachten

Das ist für 90% der Formeln super anwenderfreundlich! Leider habe ich auch eine Reihe von Formeln, die Rekursionen/Iterationen enthalten (sowas im Stile von "wiederhole den Rechenschritt so oft, bis Bedingung xy erfüllt ist"). Da stoße ich dann an die Grenzen des Ansatzes... für einfache Formeln ist das aber perfekt.


Was ich gemacht habe im VBA (für einen Messpunkt):

An einer Stelle öffentlich die Variablen (n, M, I, U, P_mechanisch, P_elektrisch) initialisiert.

An einer Stelle den Eingangsgrößen die Werte zugewiesen (n, M, I, U haben jetzt numerische Werte).

An einer Stelle die Formeln niedergeschrieben, dort werden die Formeln also auch gerechnet (P_mechanisch, P_elektrisch haben jetzt numerische Werte).

(Das sind keine Functions, sondern einfach stumpfer Code - es werden also immer alle Formeln berechnet)

Wenn ich gerade die Zelle C3 betrachte, weiß ich, dass ich dort den berechneten Wert für die Formelgröße, welche als String in Zelle A3 steht ("P_elektrisch"), reinschreiben will. Und im VBA habe ich diesen berechneten Wert ja auch schon auf der Variable P_elektrisch stehen. Ich weiß nur nicht, wie ich dem VBA verklickere, dass er den Wert der gleichnamigen Variable dareinschreibt. Also ohne es im Stile "Zeile 3 ist immer P_elektrisch" hardzucoden.

1598459043909.png



Wenn es nur schwer rüberkommt, kann ich auch nochmal die aktualisierte Beispieldatei reinpacken. Momentan ist das in einer größeren Datei enthalten, wo eben noch viel mehr passiert - ich habe versucht das Problem isoliert zu beschreiben, weil das drumherum dafür irrelevant ist und es nur unübersichtlich macht...
Ich muss nur erst den Neucode da rausziehen und so anpassen, dass es auch in der Beispieldatei tut.

Da ich versprochen habe, die/meine Lösung abschließend hier zu posten, muss ich das aber eh noch machen.
 

new Account()

Banned
Dabei seit
Mai 2018
Beiträge
7.199
3 Möglichkeiten:
1. Du splittest alles in Funktionen auf und mappst dann die Funktionen zu den Formelnamen (entweder so wie ich oder so wie @tollertyp (weniger Aufwand)
2. Select case (je nach formelname die richtige Variable nehmen)
3. Dictionary: Variableninhalte mit Formelnamen in ein Dictionary speichern ("Formelname" -> Formelwert) und dann wieder rausholen
 

tollertyp

Captain
Dabei seit
Feb. 2020
Beiträge
3.161
Okay, es gibt noch einen hässlichen Ansatz... du definierst alle Variablen (aus Rohdaten) als Modul-globale Variablen inkl. entsprechender Setter-Methoden:

Code:
Private Const Rohdaten = "Rohdaten"
Private Const Formeln = "Formeln"

Private Pi As Double
Private M As Double
Private n As Double
Private U As Double
Private I As Double

Private Sub Worksheet_Change(ByVal Target As Range)
    If Range(Target.Address).Column > 1 And Range(Target.Address).Row > 2 And Cells(Range(Target.Address).Row, 1).value <> "" And Cells(1, Range(Target.Address).Column).value <> "" Then
         calculateRow Range(Target.Address).Row
    End If
End Sub
Private Sub Worksheet_Deactivate()
    ' recalculateAll
End Sub

Private Sub recalculateAll()
    Dim Rohdaten_Row As Integer
    Rohdaten_Row = 3
    While Worksheets(Rohdaten).Cells(Rohdaten_Row, 1).value <> ""
        calculateRow Rohdaten_Row
        Rohdaten_Row = Rohdaten_Row + 1
    Wend
End Sub

Private Sub calculateRow(ByVal Rohdaten_Row As Integer)
    ' Konstanten
    Pi = WorksheetFunction.Pi

    Dim Column As Integer
    Column = 2
    While Worksheets(Rohdaten).Cells(1, Column).value <> ""
        Dim variablenName
        variablenName = Worksheets(Rohdaten).Cells(1, Column).value
        CallByName Worksheets(Rohdaten), "set_" & variablenName, VbMethod, Worksheets(Rohdaten).Cells(Rohdaten_Row, Column)
        Column = Column + 1
    Wend

    Worksheets(Formeln).Cells(1, Rohdaten_Row).value = Worksheets(Rohdaten).Cells(Rohdaten_Row, 1)

    Dim Formel
    Dim Formel_Row As Integer
    Formel_Row = 2
    While Worksheets(Formeln).Cells(Formel_Row, 1).value <> ""
        Formel = Worksheets(Formeln).Cells(Formel_Row, 1).value
        Worksheets(Formeln).Cells(Formel_Row, Rohdaten_Row).value = CallByName(Worksheets(Rohdaten), Formel, VbMethod)
        Formel_Row = Formel_Row + 1
    Wend
End Sub

Function P_mechanisch() As Double
    P_mechanisch = n * M * 2 * Pi / 60 / 1000
End Function

Function P_elektrisch() As Double
    P_elektrisch = U * I / 1000
End Function

Function P_quatsch() As Double
    P_quatsch = P_elektrisch() * P_mechanisch()
End Function

Sub set_M(value)
    M = value
End Sub

Sub set_n(value)
    n = value
End Sub

Sub set_U(value)
    U = value
End Sub

Sub set_I(value)
    I = value
End Sub

Willst du in P_quatsch() dann andere Funktionen aufrufen, die keine Eingangsgrößen sind, musst du sieh alt als normale Funktionsaufrufe schreiben.

Evtl wäre da ein Class-Module schöner?

@new Account():
Was für den einen quasi schon Reflection ist, ist für den anderen halt noch lange kein Reflection.

Aus dem englischen Wikipedia gut prägnant formuliert:
Zitat von https://en.wikipedia.org/wiki/Reflection_(computer_programming):
In computer science, reflection is the ability of a process to examine, introspect, and modify its own structure and behavior.
Welche dieser Dinge kann ich mit VBA machen?

Im ersten Link von dir ist auch genau mein Problem als Frage gestellt, und es kommt "es geht nicht". Es ist auch ein Unterschied, ob ich sage:
  • "Liebes Excel, versuch doch bitte mal eine Funktion mit dem Namen aufzurufen" und
  • "LIebes Excel, ich suche eine Funktion, ich kenne gewisse Eigenschaften von ihr, z.B. ihren Namen, und diese Funktion möchte ich dann nachher aufrufen"

Aber klar, man Reflection natürlich auch auf "Ich rufe eine Methode mit dynamischen Namen zur Laufzeit auf" reduzieren...
Ergänzung ()

So, nun habe ich es eigene Klasse, das sieht dann in VBA bei mir so aus (Tabelle3 ist nur ein Überbleibsel):
1598462812898.png


Code von Messreihe:
Code:
Private Const Rohdaten = "Rohdaten"

Private Nr As Long
Private Pi As Double
Private M As Double
Private n As Double
Private U As Double
Private I As Double

Public Sub init(ByVal Rohdaten_Row As Integer)
    Nr = Worksheets(Rohdaten).Cells(Rohdaten_Row, 1)

    ' Konstanten
    Pi = WorksheetFunction.Pi

    Dim Column As Integer
    Column = 2

    While Worksheets(Rohdaten).Cells(1, Column).value <> ""
        Dim variablenName, value
        variablenName = Worksheets(Rohdaten).Cells(1, Column).value
        value = Worksheets(Rohdaten).Cells(Rohdaten_Row, Column)
        Select Case variablenName
        Case "M": M = value
        Case "n": n = value
        Case "U": U = value
        Case "I": I = value
        Case Else
            MsgBox "Unbekannte Variable: " & variablenName
        End Select
        Column = Column + 1
    Wend
End Sub

Public Function calculate(Formel)
    calculate = CallByName(Me, Formel, VbMethod)
End Function

Function getNr() As Long
    getNr = Nr
End Function

Function P_mechanisch() As Double
    P_mechanisch = n * M * 2 * Pi / 60 / 1000
End Function

Function P_elektrisch() As Double
    P_elektrisch = U * I / 1000
End Function

Function P_quatsch() As Double
    P_quatsch = P_elektrisch() * P_mechanisch()
End Function

Code von Rohdaten:
Code:
Private Const Rohdaten = "Rohdaten"
Private Const Formeln = "Formeln"

Private Sub Worksheet_Change(ByVal Target As Range)
    If Range(Target.Address).Column > 1 And Range(Target.Address).Row > 2 And Cells(Range(Target.Address).Row, 1).value <> "" And Cells(1, Range(Target.Address).Column).value <> "" Then
         calculateRow Range(Target.Address).Row
    End If
End Sub

Private Sub Worksheet_Deactivate()
    ' recalculateAll
End Sub

Private Sub recalculateAll()
    Dim Rohdaten_Row As Integer
    Rohdaten_Row = 3
    While Worksheets(Rohdaten).Cells(Rohdaten_Row, 1).value <> ""
        calculateRow Rohdaten_Row
        Rohdaten_Row = Rohdaten_Row + 1
    Wend
End Sub

Private Sub calculateRow(ByVal Rohdaten_Row As Integer)
    Dim m As New messreihe
    m.init Rohdaten_Row

    Worksheets(Formeln).Cells(1, Rohdaten_Row).value = m.getNr()

    Dim Formel
    Dim Formel_Row As Integer
    Formel_Row = 2
    While Worksheets(Formeln).Cells(Formel_Row, 1).value <> ""
        Formel = Worksheets(Formeln).Cells(Formel_Row, 1).value
        Worksheets(Formeln).Cells(Formel_Row, Rohdaten_Row).value = m.calculate(Formel)
        Formel_Row = Formel_Row + 1
    Wend
End Sub

Statt auf das Sheet zu verweisen aus der Klasse heraus hätte auch eine Map übergeben werden können, die die einzelnen Werte der Messreihe enthält.

Edit:
Bemerkung am Rande: Das RecalculateAll geht bei dem Code nun grob doppelt so schnell, bei mir jetzt bei 4000 Einträgen nur noch grob 2s (statt 4s). Was immer noch unangenehm lang beim Wechseln des Sheets ist. Aber man könnte das ja über einen Button o.ä. aufrufen.

Die Variante mit globalen Variablen hat das Risiko, lass sich Variablen leicht "umbenennen" lassen, auch wenn man es gar nicht will... also z.B. habe ich versehentlich M in m umbenannt, weil ich die Variable für Messreihe eben m genannt hatte. Und schwupps wurde M in Messreihe auch zu m... den VBA-Editor hasse ich einfach...
 
Zuletzt bearbeitet:

new Account()

Banned
Dabei seit
Mai 2018
Beiträge
7.199
Welche dieser Dinge kann ich mit VBA machen?
examine und introspect
Ergänzung ()

Im ersten Link von dir ist auch genau mein Problem als Frage gestellt, und es kommt "es geht nicht".
Dann musst du schon weiter lesen:
There are some reflection-like things possible:
 

tollertyp

Captain
Dabei seit
Feb. 2020
Beiträge
3.161
" examine und introspect " genau das geht eben nicht...
Ich habe es sehr wohl gelesen.
Dann parse mal bitte die Klasse Messreihe und gibt alle Attribute mit Typ aus. Viel Spaß.

Und "Auf den Quellcode zugreifen" hat für mich nichts mit Reflection zu tun.
 
Zuletzt bearbeitet:

new Account()

Banned
Dabei seit
Mai 2018
Beiträge
7.199
Du hast doch selbst geschrieben, dass man den Quellcode nach Belieben parsen kann.
Wäre für mich jetzt am einfachsten. Vielleicht geht es auch über eine andere erwähnte Möglichkeit.

Klar keine wirkliche Reflektion, aber erledigt die Arbeit ( zusammen mit CallByName ) 👍
Coden kannst es selber, wenn du Lust hast.
 

tollertyp

Captain
Dabei seit
Feb. 2020
Beiträge
3.161
von "nach Belieben parsen" habe ich nichts geschrieben... auch da gibt es Hürden bei VBA...
Aber ich weiß, es kann ja nicht sein, dass man sich nicht nur oberflächlich mit Problemen und vor allem nicht mit dem beschäftigt, was man selbst in den Raum wirft...
 

Sebbl1990

Cadet 4th Year
Ersteller dieses Themas
Dabei seit
Okt. 2008
Beiträge
122
Wie versprochen hier "meine Lösung", die prinzipiell funktioniert. (jeder Codeblock ist ein eigenes Modul)
Code:
Option Explicit

Sub FormelwerteEintragen()

'Microsoft Scripting Runtime muss hinzugefügt sein!!!

    Dim Formel As Integer
    Dim Formelname As String
    Dim Messpunkt As Integer
    
    Application.ScreenUpdating = True

    AnzahlFormeln = 2 'todo: auslesen
    
    AnzahlMesspunkteErmitteln

    'Konstanten abfragen
    KonstantenDefinieren
    
    Sheets("Rohdaten").Select

    'Jeden Messpunkt durchlaufen
    For Messpunkt = 1 To AnzahlMesspunkte
        
        'Werte für die Eingangsgrößen im betrachteten Messpunkt auslesen
        WerteZuweisen (Messpunkt + 45)

        'Formelwerte für betrachteten Messpunkt berechnen
        FormelwerteBerechnen
        
        'Formelwerte für betrachteten Messpunkt in Tabelle schreiben und runden
        For Formel = 1 To AnzahlFormeln
            'Formelname in Spalte C auslesen
            Formelname = Sheets("Formeln").Cells(Formel + 10, 3)
            'Schreiben
            Sheets("Formeln").Cells(Formel + 10, Messpunkt + 10) = Formeln(Formelname)

            'Runden#########################
            Sheets("Formeln").Cells(Formel + 10, Messpunkt + 10) = Round(Sheets("Formeln").Cells(Formel + 10, Messpunkt + 10), 1) 'Letzte Zahl => NKS aus DB
        Next
        
        'Dictionary resetten
        Set Formeln = Nothing
        
    Next

    Sheets("Formeln").Select
    
    Application.ScreenUpdating = True
    
End Sub

Code:
Option Explicit

'====================================================================================================

'=== 1. Schritt für Anlegen einer neuen Formel: ===

'Normnamen der Eingangsgrößen, Konstanten und der neuen Formelgröße unten in Liste aufnehmen (Reihenfolge irrelevant)
'Falls Eingangsgröße schon vorhanden ist, muss diese nicht nochmals hinzugefügt werden

'Schema:

'Public *Normname* As Double

'====================================================================================================

Public Pi As Double
Public n As Double
Public M As Double
Public U As Double
Public I As Double
Public P_elektrisch As Double
Public P_mechanisch As Double

Code:
Option Explicit

'====================================================================================================

'=== 2. Schritt für Anlegen einer neuen Formel: ===

'Nur nötig, falls die neue Formel eine neue Konstante benutzt
'Falls Konstante schon vorhanden ist, muss diese nicht nochmals hinzugefügt werden

'Schema:

'*Normname* = *Wert*

'====================================================================================================

Sub KonstantenDefinieren()

    Pi = 3.141529

End Sub

Code:
Option Explicit

'====================================================================================================

'=== 3. Schritt für Anlegen einer neuen Formel: ===

'Normnamen der Eingangsgrößen unten in Liste aufnehmen (Reihenfolge irrelevant)
'Falls Eingangsgröße schon vorhanden ist, muss diese nicht nochmals hinzugefügt werden

'Schema:

'"*Normname* = Application.WorksheetFunction.IfError(Sheets("Rohdaten").Cells(Messpunkt, EingangsgroesseSuchen("*Normname*")).Value, 10000000000#)"

'====================================================================================================

Function WerteZuweisen(Messpunkt As Integer)

    n = Application.WorksheetFunction.IfError(Sheets("Rohdaten").Cells(Messpunkt, EingangsgroesseSuchen("n")).Value, 10000000000#)
    M = Application.WorksheetFunction.IfError(Sheets("Rohdaten").Cells(Messpunkt, EingangsgroesseSuchen("M")).Value, 10000000000#)
    U = Application.WorksheetFunction.IfError(Sheets("Rohdaten").Cells(Messpunkt, EingangsgroesseSuchen("U")).Value, 10000000000#)
    I = Application.WorksheetFunction.IfError(Sheets("Rohdaten").Cells(Messpunkt, EingangsgroesseSuchen("I")).Value, 10000000000#)
    
End Function

Code:
Option Explicit

Sub FormelwerteBerechnen()

'====================================================================================================

'=== 4. Schritt für Anlegen einer neuen Formel: ===

'Berechnungsvorschrift der neuen Formel in Liste unten aufnehmen
'Eingangsgrößen müssen zuvor in Schritt 1, 2 und 3 angelegt worden sein

'Schema:

'*Formelbeschreibung* in *Einheit*
'*Formelzeichen* = *Berechnungsvorschrift*
'Formeln.Add Key:="*Formelzeichen*", Item:=*Formelzeichen*

'====================================================================================================

'Mechanische Leistung in kW
P_mechanisch = n * M * 2 * Pi / 60 / 1000
Formeln.Add Key:="P_mechanisch", Item:=P_mechanisch

'====================================================================================================

'Elektrische Leistung in kW
P_elektrisch = U * I / 1000
Formeln.Add Key:="P_elektrisch", Item:=P_elektrisch

'====================================================================================================

End Sub

Code:
Option Explicit

Function EingangsgroesseSuchen(Suchbegriff As String)

    Dim ZelleMessgroesse As Range

    AnzahlMessgroessenErmitteln

    'Definieren des zu durchsuchenden Bereichs an Messgrößen
    With Worksheets("Rohdaten").Range("A44", Cells(44, AnzahlMessgroessen + 1))
        
        'Zelle finden, in dem die Messgröße steht
        Set ZelleMessgroesse = .Find(What:=Suchbegriff, LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlNext, MatchCase:=True, SearchFormat:=False)

        If Not ZelleMessgroesse Is Nothing Then
    
            'Falls Messgröße gefunden wurde, gebe die Spalte zurück
            EingangsgroesseSuchen = ZelleMessgroesse.Column

        Else
            
            'Falls Messgröße nicht gefunden wurde, gebe Spaltennr. von "DefaultNV" zurück
            Set ZelleMessgroesse = .Find(What:="DefaultNV", LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlNext, MatchCase:=True, SearchFormat:=False)
            EingangsgroesseSuchen = ZelleMessgroesse.Column
    
        End If

    End With

End Function

Public Function AnzahlMessgroessenErmitteln() As Integer

    'Anzahl der Messgrößen ermitteln (Kopfzeile mit Messgrößen in Standardexport)
    AnzahlMessgroessen = Worksheets("Rohdaten").Range("A44").End(xlToRight).Column
    If Worksheets("Rohdaten").Cells(44, AnzahlMessgroessen) = "DefaultNV" Then AnzahlMessgroessen = AnzahlMessgroessen - 1
    
End Function

Public Function AnzahlMesspunkteErmitteln() As Integer

    'Anzahl der Messpunkte ermitteln
    AnzahlMesspunkte = Worksheets("Rohdaten").Range("A44").End(xlDown).Row - 45
    
End Function

Code:
Option Explicit

Public LetzteAktiveTabelle As String
Public LetzteAktiveFormelwerteTabelle As String

Public AktuelleZeile As Integer
Public AktuelleSpalte As Integer

Public ZwischenspeicherGefuellt As Boolean
Public ImCode As Boolean

Public AnzahlFormeln As Integer
Public AnzahlMessgroessen As Integer
Public AnzahlMesspunkte As Integer

Public Formeln As New Scripting.Dictionary

Bezugs-/Zielzellen haben sich leicht verschoben, weil das in meiner eigentlichen Datei so ist. Daher die angehängte Datei verwenden.

Die Formeln werden aus einem Dictionary heraus abgefragt. (dein Lösungsvorschlag Nr. 3 @new Account() ) Hierzu eine Frage: Man muss dazu die "Microsoft Scripting Runtime" als Verweis hinzufügen. Muss das jeder Nutzer für sich einstellen oder hat das meine Datei jetzt quasi im Bauch und sollte prinzipiell automatisch bei jedem Nutzer funktionieren, solange die Runtime auf dem Rechner installiert ist?

Normalerweise wird die Berechnung dann über einen Button aufgerufen (in der Datei jetzt nicht enthalten), sodass die Ausführungsdauer nicht wirklich kritisch ist.

Das ist mit Sicherheit an der ein oder anderen Stelle etwas reudig programmiert, was dann meist daran liegt, dass ich es einfach mit meinem Wissensstand nicht besser kann bzw. die bessere Lösung nicht kenne. ;) Wahrscheinlich werde ich noch ein paar Fehlerbehandlungsroutinen ergänzen müssen, wenn ich irgendwo etwas noch nicht bedacht habe, das sehe ich dann wahrscheinlich erst in der Anwendung.

So viel zu meiner Lösung.

==============================

@tollertyp Deine letzte Lösung mit der Klasse sieht deutlich eleganter aus. Jetzt können 2 Sachen passieren:

1) Es wird eine Eingangsgröße in den Rohdaten gefunden, die im Code nicht angelegt wurde
2) Ich brauche für eine Formel eine Eingangsgröße, die es in den Rohdaten gar nicht gibt (-> Formel kann nicht berechnet werden)

Beide Fälle können (bzw. werden) bei mir auftreten.

zu 1) Hierfür gibst du in der Select Case Abfrage die MsgBox aus, wenn ich das richtig sehe. Das wäre für mich nutzbar (statt der MsgBox würde ich den Fall einfach ignorieren und keine Variable beschreiben)

zu 2) Wie würdest du das lösen? Wenn ich es richtig sehe, ist der Fall nicht abgefangen? Mit dem Abfangen dieses Falls habe ich mich bei meiner Lösung sehr schwer getan und es auch nur über einen bitterböse Workaround geschafft, wo jeder Programmierer wahrscheinlich die Hände über den Kopf zusammenschlägt: Ich lege jedes mal einen fiktiven Messwert mit dem Namen "DefaultNV" und einer kompletten Spalte =NV() an (das passiert automatisch, wenn ich die Messdaten einlese). Wenn die gesuchte Eingangsgröße nicht gefunden wird, soll er den Wert aus dieser Spalte (-> NV) nehmen, was dann einen Fehler wirft und für den Fehlerfall, nimmt er als numerischen Wert 10^10, sodass bei den Formeln sehr hohe oder niedrige Werte rauskommen.

Sehr unschön... lieber wäre es mir, wenn die Zellen, wo die Formeln nicht berechnet werden können einfach leer bleiben. Habe ich aber nicht hinbekommen, ohne nochmal alle Eingangsgrößen durchzuloopen und zu prüfen, was im Prinzip pro Eingangsgröße eine extra Codezeile bedeutet.

Wenn ich in meinem Code statt der 10^10 die "Null" reinschreibe, wirft er leider einen Fehler.

Code:
    n = Application.WorksheetFunction.IfError(Sheets("Rohdaten").Cells(Messpunkt, EingangsgroesseSuchen("n")).Value, 10000000000#)

Vielleicht geht das bei deiner Lösung aber deutlich einfacher zu implementieren.

Danke nochmals für den Input, das ist jetzt zumindest schon mal ein Stand, womit ich meine ursprüngliche Aufgabe lösen kann und der auch relativ einfach mit wenig Copy and Paste erweiterbar ist. Wenn auch an der ein oder anderen Stelle noch mit Potential.

Gruß
Sebastian
 

Anhänge

  • Formelberechnung_Beispiel_v8.xlsx
    10,7 KB · Aufrufe: 43
Top