Ich finde keinen Weg um eine selbst entwickelte Formel dauerhaft in Funktionsauwahl mit aufzunehmen, kennt jemand einen Weg und kann mir helfen?
Office - Word, Excel und Co. 9.754 Themen, 41.624 Beiträge
rommi (Anonym) Uwe Westhagen „eine eigene Formel in die vorhandenen Funktionen einfügen?“
PSS ID Number: D32161
Article last modified on 10-12-1999
7.0 5.0
WINDOWS
VBA Makro macro Gewogenes Mittel userdefined function
Frage:
Ich möchte in Microsoft EXCEL für WINDOWS 95, Version 7.0, ein gewogenes
Mittel errechnen lassen. Die Berechnung soll folgendermaßen erfolgen:
Ein Merkmal einer Zufallsvariablen liefert bestimmte Merkmalsausprägungen.
Diese Merkmalsausprägungen treten in bestimmter Anzahl (Gewicht) auf. Über
alle angefallenen Werte soll ein gewogenes Mittel errechnet werden. Die
Formel hierzu sieht folgendermaßen aus:
Gewogenes Mittel = Summe(Ausprägung * Gewicht) / Summe(Gewicht)
(Bei einem gewogenen Mittel im engeren Sinne ergibt die Summe der Gewichte
den Wert Eins (1). Davon soll hier aus Gründen der Rechenerleichterung
abgesehen werden.)
Wie kann ich in EXCEL 7.0 eine solche Funktion als benutzerdefinierte
Funktion implementieren und wie könnte die Funktion dann aussehen?
Antwort:
Um eine benutzerdefinierte Funktion zu erstellen, wählen Sie aus dem Menü
EINFÜGEN den Befehl MAKRO - VISUAL BASIC MODUL. EXCEL 7.0 fügt ein
Modulblatt in Ihre Arbeitsmappe ein. Im Modulblatt definieren Sie eine
Funktion.
Das folgende Beispiel zeigt eine solche Funktion.
Der Aufruf der Funktion geschieht analog dem der in EXCEL 7.0 bereits
integrierten Funktionen.
Bitte beachten Sie beim Abschreiben des VBA (VISUAL BASIC für
Applikationen)-Codes, daß zwei Zeilen, die ohne Leerzeile untereinander
stehen, EINE Codezeile darstellen. Solche Zeilen dürfen nicht mit einem
erzwungenen Umbruch geschrieben werden. Eine Leerzeile stellt also jeweils
den Beginn einer neuen Codezeile dar.
Variante 1:
Die erste Variante ist relativ einfach gehalten. Sie geht davon aus, daß die
Ausprägungen und ihre Gewichte direkt in zwei Spalten nebeneinander stehen.
Als Argument kennt die Funktion nur ein Argument, nämlich den Bereich der
nebeneinander liegenden Spalten mit den Werten.
Wird als Argument nur eine Spalte oder mehr als zwei Spalten übergeben, so
liefert die Funktion einen Fehlerwert zurück.
Option Explicit
Function GEWMITTEL(objRange As Object)
' Variablendeklaration
Dim intCols As Integer
Dim intRows As Integer
Dim i As Integer
Dim dblValue As Double
Dim dblWeight As Double
intCols = objRange.Columns.Count
intRows = objRange.Rows.Count
' Berechnung
If intCols = 2 Then
For i = 1 To intRows
dblValue = dblValue + objRange.Cells(i, 1) * objRange.Cells(i,
2)
dblWeight = dblWeight + objRange.Cells(i, 2)
Next i
GEWMITTEL = dblValue / dblWeight
Else
GEWMITTEL = Error(Error())
End If
End Function
In die EXCEL 7.0 Tabelle geben Sie dann z.B. folgendes ein:
=GEWMITTEL(A2:B10)
Variante 2:
In dieser Variante müssen weder die Ausprägungen noch die Gewichte
notwendigerweise in Spalten-Vektoren eingegeben werden, noch müssen die
Vektoren für die Ausprägungen und Gewichte nebeneinander oder übereinander
eingegeben werden. Voraussetzung ist lediglich, daß die beiden
Argument-Vektoren der Funktion dieselbe Anzahl an Werten enthalten,
andernfalls liefert die Funktion einen Fehlerwert zurück.
So ist das erste Argument der Funktion der Vektor der Ausprägungen und das
zweite Argument der Vektor der Gewichte.
Option Explicit
Function GEWMITTEL2(objValueRange As Object, objWeightRange As Object)
' Variablendeklaration
Dim i As Integer
Dim dblValue As Double
Dim dblWeight As Double
Dim intVecType As Integer
Const intRowVecRowVec As Integer = 1
Const intRowVecColVec As Integer = 2
Const intColVecRowVec As Integer = 3
Const intColVecColVec As Integer = 4
' Spezialfall Rows.Count = 1 und Columns.Count = 1
If objValueRange.Rows.Count = 1 And objValueRange.Columns.Count = 1 Then
If objWeightRange.Rows.Count = 1 And objWeightRange.Columns.Count = 1
Then
GEWMITTEL2 = objValueRange.Cells(1, 1)
Else
GEWMITTEL2 = Error(Error())
Exit Function
End If
End If
' Übergebene Vektor-Arten validieren und klassifizieren.
If objValueRange.Rows.Count = 1 And objValueRange.Columns.Count > 1 Then
If objWeightRange.Rows.Count = 1 And objWeightRange.Columns.Count > 1
Then
intVecType = intRowVecRowVec
ElseIf objWeightRange.Rows.Count > 1 And objWeightRange.Columns.Count
= 1 Then
intVecType = intRowVecColVec
Else
GEWMITTEL2 = Error(Error())
Exit Function
End If
ElseIf objValueRange.Rows.Count > 1 And objValueRange.Columns.Count = 1
Then
If objWeightRange.Rows.Count = 1 And objWeightRange.Columns.Count > 1
Then
intVecType = intColVecRowVec
ElseIf objWeightRange.Rows.Count > 1 And objWeightRange.Columns.Count
= 1 Then
intVecType = intColVecColVec
Else
GEWMITTEL2 = Error(Error())
Exit Function
End If
Else
Exit Function
End If
' Berechnung durchführen
Select Case intVecType
Case intRowVecRowVec
If objValueRange.Columns.Count = objWeightRange.Columns.Count
Then
For i = 1 To objValueRange.Columns.Count
dblValue = dblValue + objValueRange.Cells(1, i) *
objWeightRange.Cells(1, i)
dblWeight = dblWeight + objWeightRange.Cells(1, i)
Next i
Else
GEWMITTEL2 = Error(Error())
Exit Function ' ungleich lange Vektoren
End If
Case intRowVecColVec
If objValueRange.Columns.Count = objWeightRange.Rows.Count Then
For i = 1 To objValueRange.Columns.Count
dblValue = dblValue + objValueRange.Cells(1, i) *
objWeightRange.Cells(i, 1)
dblWeight = dblWeight + objWeightRange.Cells(i, 1)
Next i
Else
GEWMITTEL2 = Error(Error())
Exit Function ' ungleich lange Vektoren
End If
Case intColVecRowVec
If objValueRange.Rows.Count = objWeightRange.Columns.Count Then
For i = 1 To objValueRange.Rows.Count
dblValue = dblValue + objValueRange.Cells(i, 1) *
objWeightRange.Cells(1, i)
dblWeight = dblWeight + objWeightRange.Cells(1, i)
Next i
Else
GEWMITTEL2 = Error(Error())
Exit Function ' ungleich lange Vektoren
End If
Case intColVecColVec
If objValueRange.Rows.Count = objWeightRange.Rows.Count Then
For i = 1 To objValueRange.Rows.Count
dblValue = dblValue + objValueRange.Cells(i, 1) *
objWeightRange.Cells(i, 1)
dblWeight = dblWeight + objWeightRange.Cells(i, 1)
Next i
Else
GEWMITTEL2 = Error(Error())
Exit Function ' ungleich lange Vektoren
End If
End Select
GEWMITTEL2 = dblValue / dblWeight
End Function
In der EXCEL 7.0 Tabelle geben Sie dann z.B. folgendes ein:
=GEWMITTEL2(A16:I16;B2:B10)
Dieser VBA Code kann ohne Veränderung auch in EXCEL 5.0 eingesetzt werden.
Falls Sie im Menü EXTRAS - OPTIONEN im Register MODUL ALLGEMEIN für die
Einstellung "Sprache/Land" den Wert "Deutsch/Deutschland" gewählt haben,
finden Sie in der mit EXCEL 7.0 mitgelieferten Datei VBALISTE.XLS die
entsprechenden deutschen Befehle.
Bitte beachten Sie:
Die Verwendung des hier abgedruckten Makro- bzw. Programm-Codes geschieht
auf Ihre eigene Verantwortung. Microsoft stellt Ihnen diesen Makro bzw.
dieses Programm-Listing ohne Gewähr auf Richtigkeit, Vollständigkeit
und/oder Funktionalität, sowie ohne Anspruch auf Support zur Verfügung. Der
Makro bzw. das Programm-Listing soll lediglich exemplarisch die
Funktionsweise des hier abgedruckten oder auf der Diskette enthaltenen
Beispiels aufzeigen.
Microsoft, MS, VISUAL BASIC und MS-DOS sind eingetragene Warenzeichen.
WINDOWS und WINDOWS NT sind Warenzeichen der Microsoft Corporation.
dwareerken?
Haben Sie sich schon nach dem Jahr 2000-Status dieses Produktes erkundigt?
Umfassende Informationen zur Jahr 2000-Fähigkeit dieses Produktes finden Sie
auf der Microsoft-Jahr 2000-WebSite unter
http://microsoft.com/germany/jahr2000. Wir empfehlen Ihnen dringend, sich im
eigenen Interesse durch regelmäßigen Zugriff auf die Microsoft-Jahr
2000-Website über den aktuellsten Stand der Jahr 2000-Kategorisierung dieses
Microsoft-Produktes zu informieren. Die Microsoft-Jahr 2000-Website enthält
stets die aktuellsten Informationen von Microsoft zum Jahr 2000-Problem.
Microsoft stellt Ihnen die in der Knowledge Base angebotenen Artikel und
Informationen als Service-Leistung zur Verfügung. Microsoft übernimmt
keinerlei Gewährleistung dafür, daß die angebotenen Artikel und
Informationen auch in Ihrer Einsatzumgebung die erwünschten Ergebnisse
erzielen. Die Entscheidung darüber, ob und in welcher Form Sie die
angebotenen Artikel und Informationen nutzen, liegt daher allein bei Ihnen.
Mit Ausnahme der gesetzlichen Haftung für Vorsatz ist jede Haftung von
Microsoft im Zusammenhang mit Ihrer Nutzung dieser Artikel oder
Informationen ausgeschlossen.
