Du verwendest einen veralteten Browser. Es ist möglich, dass diese oder andere Websites nicht korrekt angezeigt werden. Du solltest ein Upgrade durchführen oder einen alternativen Browser verwenden.
Excel (Physikalische) Formeln per VBA berechnen lassen
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)
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.
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
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!
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.
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:
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:
Name
Formel
P_mechanisch
n * M * 2 * Pi / 60 / 1000
P_elektrisch
U * I / 1000
P_quatsch
P_mechanisch * P_elektrisch
und würde das hier erhalten (Die Reihenfogle ist hier aber wichtig):
1
2
3
4
P_mechanisch
kW
1,29224178
3,70079615
7,26126782
3,14159265
P_elektrisch
kW
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 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.
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.
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
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:
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):
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...
" 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.
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.
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...
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.
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.