Formel in Funktion umwandeln

Public Function psPos(Zelle As Range, Periode As String) As Double psPos = Evaluate("=(SUMPRODUCT((Ref=" & Zelle & _ ")*((LEFT(_C)=""C"")*(Periode0))*Periode)+SUMPRODUCT((RefW=" & Zelle & _ ")*((LEFT(_C)=""D"")*(Periode0))*Periode) _ _ )") End Function

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Public Function psPos(RefZelle As Range, _ Optional Periode As String = "_A", _ Optional Positiv As Boolean = True) As Variant Application.Volatile Dim sFormula As String sFormula = "=" & IIf(Positiv, "", "-") & _ "(SUMPRODUCT((Ref=""" & RefZelle & _ """)*((LEFT(_C)=""C"")*(" & Periode & "0))*" & Periode & ")+SUMPRODUCT((RefW=""" & RefZelle & _ """)*((LEFT(_C)=""D"")*(" & Periode & "0))*" & Periode & "))" If Len(sFormula) > 256 Then psPos = "Error:Formel zu lang" Else psPos = Evaluate(sFormula) End If End Function

Public Function psPos(RefZelle As Variant, _ Optional Periode As String = "_A", _ Optional Positiv As Boolean = True) As Variant Application.Volatile Dim sFormula As String, sReference As String If TypeName(RefZelle) = "String" Then sReference = """" & RefZelle & """" Else sReference = RefZelle.Address(0, 0) End If sFormula = "=" & IIf(Positiv, "", "-") & _ "(SUMPRODUCT((Ref=" & sReference & _ ")*((LEFT(_C)=""C"")*(" & Periode & "0))*" & Periode & ")+SUMPRODUCT((RefW=" & sReference & _ ")*((LEFT(_C)=""D"")*(" & Periode & "0))*" & Periode & "))" If Len(sFormula) > 256 Then psPos = "Error:Formel zu lang" Else psPos = Evaluate(sFormula) End If End Function

Hallo Renée
Das mit Application.Calculate habe ich ausprobiert und es hat auch funktioniert. Wenn ich dann allerdings die ganze Arbeitsmappe drucken wollte, waren die Zahlen nicht drin. Deshalb habe ich nun untenstehenden Code in das Worksheet mit den UDFs reingeschrieben und nun sind die Zellen immer aktuell.
Nochmals vielen Dank für die Unterstützung.
Gruss, Peter


Private Sub Worksheet_Activate()
Dim oWB As Workbook
Dim oWS As Worksheet
Set oWB = ThisWorkbook
Set oWS = oWB.Worksheets(Me.Name)
'Berechnung einschalten
oWS.EnableCalculation = True
End Sub


Private Sub worksheet_Deactivate()
Dim oWB As Workbook
Dim oWS As Worksheet
Set oWB = ThisWorkbook
Set oWS = oWB.Worksheets(Me.Name)
' Berechnung ausschalten
oWS.EnableCalculation = False
End Sub

Guten Morgen Peter,
ich würde Berechnungen in einem Tabellenblatt, die man mit den Standardfunktionen von Excel durchführen kann, niemals als benutzerdefinierte Funktion ins VBA auslagern. Es leidet immer die Rechengeschwindigkeit. Berechnungen in den Tabellenblättern werden evtl. schwieriger nachvollziehbar.
Das kommt bei mir erst zum Tragen, wenn zu viele Hilfs- und Nebenberechnungen erforderlich werden, die dann in einer benutzerdefinierten Funktion ggf. übersichtlicher dargestellt und gepflegt werden können.
Bei benutzerdefinierten Funktionen, die in Tabellenblättern verwendet werden, übergebe ich praktisch immer alle Parameter (Zellen, Zelbereiche, Werte) an die Funktion. Sonst muss für eine korrekte Akualisierung der Berechnungen mit "Application.Volatile" gearbeitet werden, was bei komplexen Berechnungen extrem auf die "Performance" durchschlägt.
Anzeige von Werten im VBA-Schrittmodus
Falls während der schrittweisen Abarbeitung von Prozeduren die Werte einzelner Funktionen oder Parameter nicht bei "Mauskontakt" angezeigt werden, dann solltest du zum Testen die Überwachung von Ausdrücken entsprechend einrichten.
Wenn du deine Berechnung in eine VBA-Function umsrtzen willst, dann koplett, wobei dann die SUMMENPRODUKT-Funktion ggf. durch entsprechende For-Next-Schleifen ersetzt werden muss.
Gruß
Franz


Formel in Tabellel:
=fncPsPos(Ref;G2;_C;"C";"D";_A;RefW)
'Userdefined Function:
Public Function fncPsPos(Ref As Range, Ref_Wert As String, _
C_Bereich As Range, C_Wert1 As String, C_Wert2 As String, _
A_Bereich As Range, RefW As Range) As Double
Dim lngZ As Long
'=SUMMENPRODUKT((Ref=G2)*((LINKS(_C)="C")*(_A0))*_A) _
+SUMMENPRODUKT((RefW=G2)*((LINKS(_C)="D")*(_A0))*_A)
'Ref auswerten
For lngZ = 1 To Ref.Rows.Count
If Ref(lngZ, 1) = Ref_Wert _
And _
((Left(C_Bereich(lngZ, 1), Len(C_Wert1)) = C_Wert1 And A_Bereich(lngZ, 1)  0)) Then
fncBerechnung = fncBerechnung + A_Bereich(lngZ, 1)
End If
Next
'RefW auswerten
For lngZ = 1 To RefW.Rows.Count
If RefW(lngZ, 1) = Ref_Wert _
And _
((Left(C_Bereich(lngZ, 1), Len(C_Wert2)) = C_Wert2 And A_Bereich(lngZ, 1)  0)) Then
fncBerechnung = fncBerechnung + A_Bereich(lngZ, 1)
End If
Next
End Function

Beliebteste Forumthreads (12 Monate)

	F	G
2	44444	C.1
3	44444	C.1

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Formel in Funktion umwandeln

11 Beiträge zum Forumthread Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread